home *** CD-ROM | disk | FTP | other *** search
/ Die Ultimative Software-P…i Collection 1996 & 1997 / Die Ultimative Software-Pakete CD-ROM fur Atari Collection 1996 & 1997.iso / tt / only_tt.acc / listings / sidekick.lst < prev   
Encoding:
File List  |  1996-09-18  |  67.1 KB  |  2,412 lines
  1. $m219136
  2. vers$=" SideKick.GFA, Vers.2/o7, 5.Febr.91, 18 Uhr, v.Pfr.Siegfried Just,Kirchweg 5,6936 Haag, GFABasic 3.5E, *** PUBLIC-DOMAIN *** "
  3. ' Wichtig fuer Accessories, die NIE terminieren duerfen:
  4. ON ERROR GOSUB fehler
  5. @init
  6. @schleife
  7. '
  8. PROCEDURE init
  9.   ap_id&=APPL_INIT()
  10.   als_prog&=0
  11.   debug!=(ap_id&=als_prog&)
  12.   abbruch!=FALSE
  13.   ' Streng auf TT-High-Modus abgestimmt!
  14.   geht!=(WORK_OUT(0)=1279) AND (WORK_OUT(1)=959)
  15.   ' Message-Buffer
  16.   DIM buff&(16)
  17.   buffer%=V:buff&(1)
  18.   ' Bildschirm-Buffer
  19.   DIM s_bytes|(153600)
  20.   scrn_buf%=VARPTR(s_bytes|(0))
  21.   ' Kopier-Buffer (auch fuer FAT u.a.)
  22.   DIM k_bytes|(32768)
  23.   kop_buf%=VARPTR(k_bytes|(0))
  24.   ' Buffer fuer Directory mit 1 Cluster
  25.   DIM d_bytes|(1024)
  26.   ddir_buf%=VARPTR(d_bytes|(0))
  27.   ' GetBIOSParameterBlock
  28.   DIM bpb&(9)
  29.   bpb%=VARPTR(bpb&(0))
  30.   '
  31.   ' Ausgangsmaterial LISTING: DATA-Zeilen benuetzen!
  32.   '
  33.   ' DATA 20,6F,00,04,20,2F,00,08,22,3C,FF,FF,FF,FF,20,C1
  34.   ' DATA 51,C8,FF,FC,4E,75
  35.   INLINE dark_l%,22
  36.   ' DATA 20,6F,00,04,20,2F,00,08,46,98,51,C8,FF,FC,4E,75
  37.   INLINE invert_l%,16
  38.   ' DATA 4E,56,00,00,48,E7,00,F0,20,6E,00,08,20,2E,00,0C
  39.   ' DATA 22,6E,00,10,22,2E,00,14,61,08,4C,DF,0F,00,4E,5E
  40.   ' DATA 4E,75,4A,81,67,40,52,40,90,81,63,3A,24,48,D5,C0
  41.   ' DATA 26,49,D7,C1,10,19,26,09,12,12,4A,6E,00,18,66,2A
  42.   ' DATA 14,80,B0,18,66,FC,14,81,B1,CA,62,1A,24,08,B3,CB
  43.   ' DATA 64,0C,18,18,B8,19,67,F6,20,42,22,43,60,E2,20,02
  44.   ' DATA 90,AE,00,08,4E,75,70,00,4E,75,3A,3C,FF,DF,14,80
  45.   ' DATA 18,18,B1,04,C8,05,66,F8,14,81,B1,CA,62,E8,24,08
  46.   ' DATA B3,CB,64,DA,18,18,1C,19,BD,04,C8,05,67,F2,20,42
  47.   ' DATA 22,43,60,DA,00,00,00,9C,00,00,00,05,BC,2C,00,00
  48.   INLINE thhust%,160
  49.   '
  50.   mx&=0
  51.   my&=0
  52.   button&=0
  53.   kstate&=0
  54.   key&=0
  55.   geklickt&=0
  56.   ac_open&=40
  57.   '
  58.   hot_key%=3
  59.   hot_key$="SHIFT-L+R"
  60.   '
  61.   befehls|=38
  62.   DIM befehl$(befehls|+1)
  63.   DATA "DIR","CD","laufw:","COPY","DEL","TYPE","MKDIR","HOTKEY","STATUS","DUMP"
  64.   DATA "MEMO","CLS","RMDIR","REN","HELP","DARK","MOVE","DMON","CALC","INV"
  65.   DATA "MERK","XBIOS","BIOS","GEMDOS","FIND","ASC","SHIP","POKE","BILD","CLUSTER"
  66.   DATA "TIME","DATE","TEST","PRINT","WO","ATTR","MEM","EXIT"
  67.   FOR befehl|=1 TO befehls|
  68.     READ befehl$(befehl|)
  69.   NEXT befehl|
  70.   '
  71.   DIM attr$(6)
  72.   DATA "ReadOnly","Hidden","System","Label","Directory","Archiv"
  73.   FOR i%=0 TO 5
  74.     READ attr$(i%)
  75.   NEXT i%
  76.   '
  77.   esc$=CHR$(27)
  78.   inv$=esc$+"p"
  79.   norm$=esc$+"q"
  80.   beep$=CHR$(7)
  81.   cur_get$=esc$+"j"
  82.   cur_put$=esc$+"k"
  83.   cltoeop$=esc$+"J"
  84.   '
  85.   rechns%=32
  86.   DIM rechn(rechns%+1),rechn$(rechns%+1),priority%(rechns%+1)
  87.   rechnarts%=4
  88.   DIM rechnart$(rechnarts%+1)
  89.   rechnart$(1)="+"
  90.   rechnart$(2)="-"
  91.   rechnart$(3)="/"
  92.   rechnart$(4)="*"
  93.   calc$=""
  94.   ' Welche Laufwerke sind angeschlossen?
  95.   DIM drive!(16)
  96.   dr_v%=BIOS(10)
  97.   drive!(0)=TRUE
  98.   drive!(1)=TRUE
  99.   FOR i%=2 TO 15
  100.     IF BTST(dr_v%,i%) THEN
  101.       drive!(i%)=TRUE
  102.     ELSE
  103.       drive!(i%)=FALSE
  104.     ENDIF
  105.   NEXT i%
  106.   ' Ermittle Letzte Partition, Letzten Sektor
  107.   i%=16
  108.   DO
  109.     DEC i%
  110.     EXIT IF drive!(i%) OR i%<2
  111.   LOOP
  112.   IF i%>1 THEN
  113.     BMOVE BIOS(7,i%),bpb%,18
  114.     end_drive%=i%
  115.     end_sector%=bpb&(6)+bpb&(7)*bpb&(1)
  116.   ENDIF
  117.   '
  118.   fehler!=FALSE
  119.   DIM file$(1)
  120.   merken!=FALSE
  121.   '
  122.   such$=""
  123.   such%=0
  124.   suchfile$=""
  125.   '
  126.   wildcard!=FALSE
  127.   s_startp%=0
  128.   d_startp%=0
  129.   DIM s_nam_mask!(8),s_ext_mask!(3)
  130.   s_nam_mask$="        "
  131.   s_ext_mask$="   "
  132.   '
  133.   fnams%=32
  134.   DIM s_file$(fnams%+1),d_file$(fnams%+1)
  135.   datein%=0
  136.   tiefe%=0
  137.   ord%=0
  138.   '
  139.   prnt!=FALSE
  140.   memo$=""
  141.   '
  142. RETURN ! init
  143. '
  144. PROCEDURE schleife
  145.   IF ap_id&=als_prog& THEN
  146.     PRINT AT(1,2);" Hot-Key: Beide Shift-Tasten"
  147.     DO
  148.       @abfrage
  149.       EXIT IF abbruch!
  150.     LOOP
  151.     ALERT 3,"Nur als .ACC-Test|gedacht!",1,"ENDE",dummy%
  152.     END
  153.   ELSE ! Als Accessory
  154.     IF geht! THEN
  155.       me_id&=MENU_REGISTER(ap_id&,"  SideKick: L^^R ")
  156.       PRINT
  157.       PRINT " --- 'SideKick' im Hintergrund von Pfr.S.Just, Haag, GFABasic 3.5E, Hotkey: Beide Shift-Tasten ---"
  158.       DO
  159.         @abfrage
  160.       LOOP
  161.     ELSE ! Geht nicht!
  162.       DO
  163.         ~EVNT_TIMER(-1)
  164.       LOOP
  165.     ENDIF
  166.   ENDIF
  167. RETURN ! schleife
  168. PROCEDURE abfrage
  169.   LOCAL rueck&
  170.   rueck&=EVNT_MULTI(&X110000,0,0,0,0,0,0,0,0,0,0,0,0,0,buffer%,100,mx&,my&,button&,kstate&,key&,geklickt&)
  171.   IF rueck&=&X100000 THEN ! Timer
  172.     IF kstate&=hot_key% THEN
  173.       @main
  174.     ENDIF
  175.   ELSE ! Accessory, hoffentlich das Richtige
  176.     IF buff&(1)=ac_open& THEN
  177.       @main
  178.     ENDIF
  179.   ENDIF
  180.   rueck&=0
  181.   buff&(1)=0
  182. RETURN ! abfrage
  183. '
  184. PROCEDURE main
  185.   LOCAL i%,w$,tail$,p%,x%,y%
  186.   '
  187.   BMOVE XBIOS(2),scrn_buf%,153600
  188.   x%=CRSCOL
  189.   y%=CRSLIN
  190.   CLS
  191.   PRINT inv$;vers$;norm$
  192.   SPOKE &H484,&X1111 ! Status-Umschalttasten
  193.   '
  194.   drv$=CHR$(65+GEMDOS(&H19))
  195.   path$=DIR$(0)
  196.   '
  197.   DO
  198.     ~FRE(0)
  199.     @befehls_anzeige
  200.     PRINT drv$;":";path$;"> ";inv$;" Welcher Befehl ? ";norm$;" ";
  201.     IF NOT merken! THEN
  202.       w$=""
  203.     ENDIF
  204.     FORM INPUT 120 AS w$
  205.     w$=TRIM$(UPPER$(w$))
  206.     EXIT IF LEFT$(w$,4)="EXIT"
  207.     '
  208.     fehler!=FALSE
  209.     PRINT
  210.     IF MID$(w$,2,1)=":" THEN
  211.       befehl|=3
  212.       tail$=w$
  213.     ELSE
  214.       befehl|=0
  215.       REPEAT
  216.         INC befehl|
  217.       UNTIL INSTR(w$,befehl$(befehl|))=1 OR befehl|>befehls|
  218.     ENDIF
  219.     IF befehl|>befehls| THEN
  220.       PRINT " ";inv$;" Unbekannt: ";norm$;w$;beep$
  221.     ELSE
  222.       path$=DIR$(0)
  223.       drv$=CHR$(65+GEMDOS(&H19))
  224.       p%=INSTR(w$,befehl$(befehl|))
  225.       IF p%=1 THEN
  226.         tail$=RIGHT$(w$,LEN(w$)-LEN(befehl$(befehl|)))
  227.       ENDIF
  228.       tail$=TRIM$(tail$)
  229.       SELECT befehl|
  230.       CASE 1 ! DIR
  231.         @dir_anz(tail$)
  232.       CASE 2 ! CHDIR
  233.         @dir_change(tail$)
  234.       CASE 3 ! CHDRV
  235.         @drv_change(tail$)
  236.       CASE 4 ! COPY
  237.         @kopiere(FALSE,tail$,FALSE)
  238.       CASE 5 ! DEL
  239.         @del_file(tail$)
  240.       CASE 6 ! TYPE
  241.         @show_asc(tail$)
  242.       CASE 7 ! MD
  243.         @md(tail$)
  244.       CASE 8 ! HOTKEY
  245.         @neu_hot_key
  246.       CASE 9 ! STATE
  247.         @state
  248.       CASE 10 ! DUMP
  249.         @hex_dump(tail$)
  250.       CASE 37 ! MEM
  251.         @mem_dump(tail$)
  252.       CASE 12 ! CLS
  253.         CLS
  254.         PRINT inv$;vers$;norm$
  255.       CASE 13 ! RD
  256.         @rd(tail$)
  257.       CASE 14 ! REN
  258.         @kopiere(TRUE,tail$,FALSE)
  259.       CASE 15 ! HELP
  260.         @hilfe
  261.       CASE 16 ! DARK
  262.         ~C:dark_l%(L:XBIOS(2),L:153600 DIV 4)
  263.         x$=INPUT$(1)
  264.         PRINT AT(1,1);
  265.       CASE 17 ! MOVE
  266.         @kopiere(FALSE,tail$,TRUE)
  267.       CASE 18 ! DMON
  268.         @disk_mon(tail$)
  269.       CASE 19 ! CALC
  270.         @calc(tail$)
  271.       CASE 20 ! INV
  272.         ~C:invert_l%(L:XBIOS(2),L:153600 DIV 4)
  273.       CASE 21 ! MERK
  274.         merken!=NOT merken!
  275.       CASE 22 ! XBIOS
  276.         @xb
  277.       CASE 23 ! BIOS
  278.         @b
  279.       CASE 24 ! GEMDOS
  280.         @g
  281.       CASE 25 ! FIND
  282.         PRINT " Finde e.Wert (3A45/'d4000': DEC!), e.ASC-Zeichenkette ('$Hallo') oder e.Zeichenkette mit 2-stell.-HEX-Werten ('0007E5) ? ";
  283.         FORM INPUT 120 AS such$
  284.         IF LEFT$(such$,1)="$" THEN
  285.           such$=RIGHT$(such$,LEN(such$)-1)
  286.           such%=0
  287.         ELSE IF LEFT$(such$,1)="'"
  288.           such$=RIGHT$(such$,LEN(such$)-1)
  289.           IF ODD(LEN(such$)) THEN
  290.             such$=LEFT$(such$,LEN(such$)-1)
  291.           ENDIF
  292.           w$=""
  293.           FOR i%=1 TO LEN(such$) STEP 2
  294.             w$=w$+CHR$(VAL("&H"+MID$(such$,i%,2)))
  295.           NEXT i%
  296.           such$=w$
  297.           w$=""
  298.           such%=0
  299.         ELSE
  300.           IF LEFT$(such$,1)="d" THEN
  301.             such%=VAL(MID$(such$,2,255))
  302.           ELSE
  303.             such%=VAL("&H"+such$)
  304.           ENDIF
  305.           such$=""
  306.         ENDIF
  307.         INPUT " Startpunkt Speicheradresse/Dateioffset/Sektornummer (in HEX) ";w$
  308.         IF w$="" THEN
  309.           sstart%=0
  310.         ELSE
  311.           sstart%=VAL("&H"+w$)
  312.         ENDIF
  313.         PRINT " Suche im ";inv$;"S";norm$;"peicher, in einer ";inv$;"D";norm$;"atei oder auf dem ";inv$;"M";norm$;"assenspeicher ";
  314.         w$=UPPER$(INPUT$(1))
  315.         SELECT w$
  316.         CASE "S"
  317.           @find_in_mem
  318.         CASE "D"
  319.           @find_in_file
  320.         CASE "M"
  321.           @find_on_disk
  322.         ENDSELECT
  323.       CASE 26 ! ASC
  324.         @asc_tab
  325.       CASE 27 ! SHIP
  326.         @quasi_ship
  327.       CASE 28 ! POKE
  328.         @poken
  329.       CASE 29
  330.         PRINT " Bild VOR dem Aufruf von SideKick.GFA ";inv$;"S";norm$;"peichern oder irgendein Bild ";inv$;"L";norm$;"aden ? ";
  331.         w$=UPPER$(INPUT$(1))
  332.         PRINT
  333.         SELECT w$
  334.         CASE "S"
  335.           @bild_speichern
  336.         CASE "L"
  337.           @bild_laden
  338.         ENDSELECT
  339.       CASE 30 ! CLUST
  340.         @cluster(tail$)
  341.         fehler!=FALSE
  342.       CASE 31 ! TIME
  343.         @timeset(tail$)
  344.       CASE 32 ! DATE
  345.         @dateset(tail$)
  346.       CASE 33 ! TIME
  347.         @test(tail$)
  348.       CASE 34 ! PRINT
  349.         @printer
  350.       CASE 35 ! WO
  351.         @wo(tail$)
  352.       CASE 36 ! ATTRB
  353.         @attrb(tail$)
  354.       CASE 11 ! MEMO
  355.         @memo(tail$)
  356.       CASE 38 ! EXIT
  357.         ' Niemals
  358.       DEFAULT
  359.         PRINT inv$;"Befehl ";befehl|;" = ";befehl$(befehl|);" noch nicht eingebaut!";norm$
  360.       ENDSELECT
  361.     ENDIF
  362.   LOOP
  363.   '
  364.   IF prnt! THEN
  365.     CLOSE #3
  366.   ENDIF
  367.   '
  368.   ~FRE(0)
  369.   abbruch!=(LEFT$(w$,4)="EXIT") ! Programmversion
  370.   BMOVE scrn_buf%,XBIOS(2),153600
  371.   PRINT AT(x%,y%);
  372. RETURN ! main
  373. PROCEDURE befehls_anzeige
  374.   PRINT
  375.   PRINT " ";inv$;" *** Befehle *** ";
  376.   PRINT " HOT-Key: ";norm$;hot_key$;inv$;" MERK: ";norm$;
  377.   IF merken! THEN
  378.     PRINT "ON";
  379.   ELSE
  380.     PRINT "OFF";
  381.   ENDIF
  382.   PRINT inv$;" MITSCHREIBEN: ";norm$;
  383.   IF prnt! THEN
  384.     PRINT "ON";
  385.   ELSE
  386.     PRINT "OFF";
  387.   ENDIF
  388.   PRINT
  389.   PRINT STRING$(150,".");inv$
  390.   FOR befehl|=1 TO befehls|
  391.     IF CRSCOL>149 THEN
  392.       PRINT
  393.     ENDIF
  394.     PRINT LEFT$(befehl$(befehl|)+"        ",8);norm$;"  ";inv$;
  395.   NEXT befehl|
  396.   PRINT
  397.   PRINT norm$;STRING$(150,".")
  398. RETURN ! befehls_anzeige
  399. '
  400. PROCEDURE memo(in$)
  401.   IF in$="" THEN
  402.     PRINT " ";inv$;"MEMO aaa";norm$;" hängt 'aaa' an die MEMO-Zeichenkette an. ";inv$;"MEMO";norm$;" zeigt die Zeichenkette an und bietet sie zur Editierung an:"
  403.     PRINT " ";
  404.     FORM INPUT 150 AS memo$
  405.   ELSE
  406.     memo$=memo$+" "+in$
  407.   ENDIF
  408. RETURN ! memo
  409. '
  410. PROCEDURE wo(in$)
  411.   LOCAL p%,dr%,w$,dta%
  412.   ' Abgeschaut v.Cl.Brod/A.Stepper,Scheibenkleister,S.52f
  413.   IF in$="" THEN
  414.     PRINT " Suchmuster [laufw:][pfad(e)]maske, z.B. 'C:\*.S' ? ";
  415.     INPUT "",in$
  416.     in$=TRIM$(UPPER$(in$))
  417.   ENDIF
  418.   IF in$>"" THEN
  419.     ~FRE(0)
  420.     tiefe%=0
  421.     ord%=0
  422.     datein%=0
  423.     dta%=FGETDTA()
  424.     p%=INSTR(in$,":")
  425.     IF p%>0 THEN
  426.       IF p%=2 THEN
  427.         dr%=ASC(LEFT$(in$,1))-65
  428.         IF BTST(dr_v%,dr%) THEN
  429.           w$=@set_path$(LEFT$(in$,2)+"\")
  430.           CLS
  431.           PRINT " ";inv$;" WO sind alle '";in$;"'? ";norm$
  432.           in$=MID$(in$,3,255)
  433.           @tree("",in$)
  434.           ~FSETDTA(dta%)
  435.           PRINT ord%;" Ordner, ";datein%;" Dateien"
  436.           IF CRSLIN>54 THEN
  437.             PRINT inv$;" Press a Key! ";norm$;
  438.             w$=INPUT$(1)
  439.           ENDIF
  440.           @set_path_org
  441.         ELSE
  442.           @melde("Dieses Laufwerk ist nicht angeschlossen")
  443.         ENDIF
  444.       ELSE
  445.         @melde("Falsche Drive-Angabe")
  446.       ENDIF
  447.     ELSE
  448.       CLS
  449.       PRINT " ";inv$;" WO sind alle '";in$;"'? ";norm$
  450.       @tree("",in$)
  451.       ~FSETDTA(dta%)
  452.       PRINT ord%;" Ordner, ";datein%;" Dateien"
  453.       IF CRSLIN>54 THEN
  454.         PRINT inv$;" Press a Key! ";norm$;
  455.         w$=INPUT$(1)
  456.       ENDIF
  457.     ENDIF
  458.     ~FRE(0)
  459.   ENDIF
  460.   fehler!=FALSE
  461. RETURN ! wo
  462. PROCEDURE tree(ord$,in$)
  463.   LOCAL p$,p%,fehler%,buf$,buf%,n$,h$,x$,f!
  464.   INC tiefe%
  465.   buf$=STRING$(44,CHR$(0))
  466.   buf%=VARPTR(buf$)
  467.   ~FSETDTA(buf%)
  468.   p%=RINSTR(in$,"\")
  469.   IF p%>0 THEN
  470.     p$=LEFT$(in$,p%)
  471.     in$=MID$(in$,p%+1,255)
  472.   ENDIF
  473.   fehler%=FSFIRST(p$+in$,0)
  474.   f!=FALSE
  475.   IF fehler%>=0 THEN
  476.     f!=TRUE
  477.     IF ord$>"" THEN
  478.       PRINT ord$
  479.       @prnt(ord$,TRUE)
  480.       INC ord%
  481.       PRINT SPACE$(tiefe%);
  482.       @prnt(SPACE$(tiefe%),FALSE)
  483.     ENDIF
  484.     h$=CHAR{buf%+30}
  485.     p%=INSTR(h$,".")
  486.     IF CRSLIN>58 THEN
  487.       x$=INPUT$(1)
  488.       CLS
  489.     ENDIF
  490.     IF CRSCOL>140 THEN
  491.       PRINT
  492.       @prnt("",TRUE)
  493.       PRINT SPACE$(tiefe%);
  494.       @prnt(SPACE$(tiefe%),FALSE)
  495.     ENDIF
  496.     INC datein%
  497.     IF p% THEN
  498.       PRINT LEFT$(LEFT$(h$,p%-1)+"________",8);".";LEFT$(MID$(h$,p%+1,3)+"___",3);" ";
  499.       @prnt(LEFT$(LEFT$(h$,p%-1)+"________",8)+"."+LEFT$(MID$(h$,p%+1,3)+"___",3)+" ",FALSE)
  500.     ELSE
  501.       PRINT LEFT$(h$+"________",8);".___ ";
  502.       @prnt(LEFT$(h$+"________",8)+".___ ",FALSE)
  503.     ENDIF
  504.     fehler%=FSNEXT()
  505.     WHILE fehler%>=0
  506.       INC datein%
  507.       h$=CHAR{buf%+30}
  508.       p%=INSTR(h$,".")
  509.       IF CRSLIN>58 THEN
  510.         x$=INPUT$(1)
  511.         CLS
  512.       ENDIF
  513.       IF CRSCOL>140 THEN
  514.         PRINT
  515.         @prnt("",TRUE)
  516.         PRINT SPACE$(tiefe%);
  517.         @prnt(SPACE$(tiefe%),FALSE)
  518.       ENDIF
  519.       IF p% THEN
  520.         PRINT LEFT$(LEFT$(h$,p%-1)+"________",8);".";LEFT$(MID$(h$,p%+1,3)+"___",3);" ";
  521.         @prnt(LEFT$(LEFT$(h$,p%-1)+"________",8)+"."+LEFT$(MID$(h$,p%+1,3)+"___",3)+" ",FALSE)
  522.       ELSE
  523.         PRINT LEFT$(h$+"________",8);".___ ";
  524.         @prnt(LEFT$(h$+"________",8)+".___ ",FALSE)
  525.       ENDIF
  526.       fehler%=FSNEXT()
  527.     WEND
  528.   ENDIF
  529.   IF f! THEN
  530.     PRINT
  531.   ENDIF
  532.   ' Ordner-Suche
  533.   fehler%=FSFIRST(p$+"*.*",16)
  534.   IF fehler%>=0 THEN
  535.     IF BYTE{buf%+21}=16 THEN
  536.       n$=CHAR{buf%+30}
  537.       IF n$<>"." AND n$<>".." THEN
  538.         IF CRSLIN>58 THEN
  539.           x$=INPUT$(1)
  540.           CLS
  541.         ENDIF
  542.         h$=SPACE$(tiefe%-1)+inv$+p$+n$+"\"+norm$
  543.         @tree(h$,p$+n$+"\"+in$)
  544.         ~FSETDTA(buf%)
  545.       ENDIF
  546.     ENDIF
  547.     fehler%=FSNEXT()
  548.     WHILE fehler%>=0
  549.       IF BYTE{buf%+21}=16 THEN
  550.         n$=CHAR{buf%+30}
  551.         IF n$<>"." AND n$<>".." THEN
  552.           IF CRSLIN>58 THEN
  553.             x$=INPUT$(1)
  554.             CLS
  555.           ENDIF
  556.           h$=SPACE$(tiefe%-1)+inv$+p$+n$+"\"+norm$
  557.           @tree(h$,p$+n$+"\"+in$)
  558.           ~FSETDTA(buf%)
  559.         ENDIF
  560.       ENDIF
  561.       fehler%=FSNEXT()
  562.     WEND
  563.   ENDIF
  564.   DEC tiefe%
  565. RETURN ! find
  566. '
  567. PROCEDURE attrb(in$)
  568.   LOCAL e%,dta%,h$,t$,attr%,i%,w$,a%,nach!
  569.   IF in$="" THEN
  570.     PRINT " Welche Datei? ";
  571.     INPUT "",in$
  572.   ENDIF
  573.   fehler!=FALSE
  574.   @check_drv(in$)
  575.   IF NOT fehler! THEN
  576.     t$=MID$(@set_path$(in$),3,255)+"\"
  577.     IF INSTR(in$,"*") OR INSTR(in$,"?") THEN
  578.       nach!=TRUE
  579.     ELSE
  580.       nach!=FALSE
  581.     ENDIF
  582.     dta%=FGETDTA()
  583.     e%=FSFIRST(in$,-1)
  584.     IF e%<0 THEN
  585.       PRINT inv$;" *** Keine Datei gefunden! *** ";norm$;beep$
  586.     ELSE
  587.       FOR i%=0 TO 5
  588.         PRINT " ";i%;":";attr$(i%);" ";
  589.       NEXT i%
  590.       PRINT inv$;"Welches Bit wollen Sie wechseln ? ";norm$;" ";
  591.       w$=INPUT$(1)
  592.       PRINT
  593.       IF w$>"/" AND w$<"6" THEN
  594.         a%=VAL(w$)
  595.       ENDIF
  596.     ENDIF
  597.     DO
  598.       EXIT IF e%<0
  599.       h$=CHAR{dta%+30}
  600.       h$=t$+h$+CHR$(0)
  601.       i%=INSTR(h$,"\\")
  602.       IF i% THEN
  603.         h$=LEFT$(h$,i%)+MID$(h$,i%+2,255)
  604.       ENDIF
  605.       attr%=GEMDOS(&H43,L:VARPTR(h$),0,0) AND 63
  606.       IF attr%<>&X11111 THEN
  607.         IF nach! THEN
  608.           PRINT " ";inv$;h$;norm$;" hat die Attribute ";
  609.           PRINT BIN$(attr%,6);"=";
  610.           FOR i%=0 TO 5
  611.             IF BTST(attr%,i%) THEN
  612.               PRINT attr$(i%);" ";
  613.             ENDIF
  614.           NEXT i%
  615.           PRINT " ";attr$(a%);" ";
  616.           IF BTST(attr%,a%) THEN
  617.             PRINT "Löschen ? ";
  618.           ELSE
  619.             PRINT "Setzen ? ";
  620.           ENDIF
  621.           PRINT " ['j',...] ";
  622.           w$=UPPER$(INPUT$(1))
  623.           PRINT
  624.         ELSE
  625.           w$="J"
  626.         ENDIF
  627.         IF w$="J" THEN
  628.           attr%=BCHG(attr%,a%)
  629.           ~GEMDOS(&H43,L:VARPTR(h$),1,attr%)
  630.         ENDIF
  631.       ENDIF
  632.       e%=FSNEXT()
  633.     LOOP
  634.     @set_path_org
  635.   ENDIF
  636.   fehler!=FALSE
  637. RETURN ! attrb
  638. '
  639. PROCEDURE timeset(in$)
  640.   LOCAL p%
  641.   IF in$=""
  642.     PRINT TIME$;" hh.mm ? ";
  643.     INPUT "",in$
  644.   ENDIF
  645.   IF in$>"" THEN
  646.     p%=INSTR(in$,".")
  647.     IF p%=0 THEN
  648.       p%=INSTR(in$,",")
  649.       IF p%=0 THEN
  650.         p%=INSTR(in$,":")
  651.         IF p%=0 THEN
  652.           p%=INSTR(in$," ")
  653.           IF p%=0 THEN
  654.             p%=1
  655.           ENDIF
  656.         ENDIF
  657.       ENDIF
  658.     ENDIF
  659.     hh$=LEFT$(in$,p%-1)
  660.     mm$=MID$(in$,p%+1,255)
  661.     TIME$=hh$+":"+mm$+":00"
  662.   ENDIF ! Eingabe vorhanden
  663. RETURN ! timeset
  664. PROCEDURE dateset(in$)
  665.   LOCAL p%,pp%
  666.   IF in$=""
  667.     PRINT DATE$;" tt.mm.jjjj ";
  668.     INPUT "",in$
  669.   ENDIF
  670.   IF in$>"" THEN
  671.     p%=INSTR(in$,".")
  672.     pp%=RINSTR(in$,".")
  673.     IF p%>0 AND pp%>0 THEN
  674.       DATE$=LEFT$(in$,p%)+MID$(in$,p%+1,pp%-p%)+MID$(in$,pp%+1,4)
  675.     ELSE
  676.       PRINT inv$;" *** Falsche Angabe! '.' nur erlaubt! *** ";norm$;beep$
  677.     ENDIF
  678.   ENDIF ! Eingabe vorhanden
  679. RETURN ! dateset
  680. '
  681. PROCEDURE hilfe
  682.   LOCAL x$,dr%,b&,dd%
  683.   CLS
  684.   PRINT inv$;vers$;norm$;" --- arbeitet wie folgt: ---"
  685.   PRINT " SideKick.GFA ist ein Accessory, das vom GEM-Dispatcher alle 0.1 Sekunden aufgerufen wird (EVNT_TIMER). SideKick.GFA stellt nun fest, ob die letzte Steuer~"
  686.   PRINT "   tastenkombination dem sog. 'HOT-KEY' entspricht. Traf dies zu, wird die Hauptschleife aufgerufen."
  687.   PRINT " Das Programm, aus dem SideKick.GFA aufgerufen werden soll, muß seinerseits den GEMDOS-Dispatcher ab und zu aufrufen. Jedes GEM-Programm macht dies. In"
  688.   PRINT "   eigenen Programmen müssen Sie dazu Aufrufe an das AES mit EVNT_~ tätigen. Der Befehl ON MENU macht dies z.B. in GFABasic."
  689.   PRINT " Der Bildschirm-Hintergrund von 150 KByte wird von SideKick.GFA in einen eigenen Puffer gerettet. Dieser Puffer wird schon beim Booten belegt! TOS-Pro~"
  690.   PRINT "   gramme oder GFABasic-Compilate reagieren z.T. nicht auf die Update-Aufforderung nach FORM_DIAL(finished) oder hinterlassen einen schwarzen Bildschirm."
  691.   PRINT " Im Fehler-Fall (ON ERROR GOSUB), der bei einem Dialog mit einem Benutzer immer auftreten kann, wird der Hintergrund restauriert und SideKick.GFA geht in"
  692.   PRINT "   eine Endlosschleife (EVNT_TIMER(-1)). SideKick.GFA läßt sich nun überhaupt nicht mehr aufrufen, aber der TT arbeitet anstandslos weiter!!!"
  693.   PRINT "                  ";inv$;" *** SYNTAX der Befehle *** ";norm$
  694.   PRINT "   --- Die Befehle müssen immer VOLLSTÄNDIG ausgeschrieben werden! --- Groß-/Klein-Schreibung sind bedeutungslos! ---"
  695.   PRINT " ";inv$;"COPY datei1 datei2";norm$;" kopiert die Datei-1 zur Datei-2. Ist diese bereits vorhanden, erfolgt eine Sicherheitsabfrage. 'datei1','datei2' sind vollständige"
  696.   PRINT "   Dateinamen mit Pfadangabe. Die 'Wildcards' '*' und '?' können verwendet werden. Wenn Sie im aktuellen Verzeichnis bleiben, brauchen Sie den Pfad nicht"
  697.   PRINT "   anzugeben! ";inv$;"MOVE datei1 datei2";norm$;" löscht 'datei1' nach dem Kopiervorgang. Wieder können '*' und '?' verwendet werden."
  698.   PRINT " ";inv$;"REN altname neuname";norm$;" arbeitet ähnlich wie COPY. Ist 'neuname' schon vorhanden, wird nachgefragt, ob Sie diesen Namen doch verwenden wollen. Wenn ja, wird die"
  699.   PRINT "   bereits vorhandene Datei 'neuname' GELÖSCHT (!) und die Datei 'altname' umbenannt in 'neuname'. Auch hier sind '*' und '?' möglich!"
  700.   PRINT " ";inv$;"MERK";norm$;" schaltet die Option 'Kommando-Zeile Merken' wechselweise EIN/AUS. Ist MERK eingeschaltet, wird die alte Kommandozeile zum Editieren angeboten, ESC"
  701.   PRINT "   löscht die Eingabe, DEL/BACKSPACE, <-/-> arbeiten wie gewohnt, ^ stellt auf den Anfang, v auf das Ende der Zeile (FORM INPUT AS)."
  702.   PRINT " ";inv$;"TYPE datei";norm$;", ";inv$;"DUMP datei";norm$;", ";inv$;"DEL datei";norm$;" stellen eine Datei in ASC_II-Form oder als HEX-Dump dar oder löschen die angegebene Datei. Zum Namen siehe COPY."
  703.   PRINT " ";inv$;"MEM adresse";norm$;" oder ";inv$;"MEM dadresse";norm$;" zeigen den Hauptspeicher-Inhalt ab der Adresse HEX-adresse oder DECIMAL-Adresse. Im 2.Fall muß ein kleines 'd' vorangestellt"
  704.   PRINT "   werden. Da LPEEK im Supervisor-Mode arbeitet, kann auch auf geschützte Bereiche zugegriffen werden."
  705.   PRINT " ";inv$;"DMON sektor";norm$;" liest ab HEX 'sektor' vom aktuellen Laufwerk mittels ReadWriteAbsolute (BIOS 4) immer jeweils 3 Sektoren zu 512 Bytes ein und stellt sie als HEX-"
  706.   PRINT "   Dump dar. Steht vor 'sektor' ein kleines 'd', wird die Sektorangabe als DECIMAL verstanden."
  707.   PRINT " ";inv$;"CLUSTER datei";norm$;" gibt die Cluster-Nummern einer Datei aus und stellt die Plattenbelegung grafisch dar. Directories mit mehr als 32 Einträgen (1 Cluster) kann"
  708.   PRINT "   SideKick.GFA nicht durchsuchen!"
  709.   PRINT " ";inv$;"FIND";norm$;" sucht nach einer Zeichenkette oder einem Zahlenwert im Speicher, auf der Diskette oder in einer Datei. Beim Aufruf erscheinen Erläuterungen."
  710.   PRINT " ";inv$;"DARK";norm$;" 'schaltet' den TT-MONOCHROM-Bildschirm dunkel und wartet dann auf irgendeinen Tastendruck. INNERHALB von SideKick.GFA erfolgt kein Aufruf an den GEM-"
  711.   PRINT "   Dispatcher. Das Accessory SCRSAV_H.GFA (Vom selben Autor) kann deshalb nicht eingreifen. Nach DARK bleibt der Bildschirm invertiert, mit ";inv$;"CLS";norm$;" können Sie das"
  712.   PRINT "   ändern. ";inv$;"INV";norm$;" invertiert den gesamten Bildschirm."
  713.   PRINT " Mit ";inv$;"DIR [pfad][muster]";norm$;" erhalten Sie die Dateienanzeige von 'pfad' nach dem 'muster'. Beide Angaben sind optional. Fehlt 'pfad', wird der aktuelle Pfad ge-"
  714.   PRINT "   nommen. Fehlt 'muster', wird das Muster '*.*' verwendet. Da nur GFABasic_3.5E-Befehle verwendet werden, ist nur das Wildcard-Zeichen '*' erlaubt, das nur"
  715.   PRINT "   am Ende des Namens oder der Extension einen Sinn macht: '*.S', 'S*.*', 'E*.P*' sind zugelassene Muster, '*S.*', '*.*G' aber nicht! In 'pfad' darf ein"
  716.   PRINT "   Laufwerksbezeicher wie 'c:' erscheinen!"
  717.   PRINT " ";inv$;"CD pfad";norm$;" arbeitet NUR auf dem aktuellen Laufwerk! Damit können Sie das Laufwerk NICHT wechseln. In 'pfad' darf auch '..' vorkommen."
  718.   PRINT " ";inv$;"a:";norm$;" wechselt das Laufwerk, wobei 'a' der Buchstabe des Laufwerks ist."
  719.   PRINT " ";inv$;"PRINT";norm$;" öffnet die (vorhandene) Datei MTSCHRFT.ASC und hängt die mitprotokollierten Bildschirmausgaben an das Ende dieser Datei. Wird durch ein 2.'PRINT' die"
  720.   PRINT "   Datei MTSCHRFT.ASC wieder geschlossen, können Sie diese auf Nachfrage auf Ihrem Drucker ausgeben lassen."
  721.   PRINT " ";inv$;"CALC formel";norm$;" berechnet 'formel' und speichert das Ergebnis zur weiteren Verwendung bei erneutem Aufruf von CALC ab. 'formel' darf REAL-Zahlen mit '.' und"
  722.   PRINT "   ',' enthalten, aber keine Exponenten. Beliebig viele Klammerebenen sind erlaubt. Alle 4 Grundrechenarten '+','-','*','/' dürfen vorkommen. Das Ergebnis"
  723.   PRINT "   wird decimal, hexadecimal, binär und oktal ausgegeben. Wenn vor 'formel' '&h', '&x', '&o' steht, wird 'formel' als einfache Hexadecimal-/Binär-/Oktal-Zahl"
  724.   PRINT "   verstanden und in allen 4 Zahlensystemen - umgerechnet - ausgegeben."
  725.   PRINT " ";inv$;"XBIOS";norm$;",";inv$;"BIOS";norm$;",";inv$;"GEMDOS";norm$;" rufen die entsprechenden Routinen des TOS auf. Neben der Funktionsnummer können max. 2 NUMERISCHE Parameter übergeben werden. * Vorsicht! *"
  726.   PRINT " ";inv$;"TIME";norm$;" und ";inv$;"DATE";norm$;" geben die Zeit aus und erlauben die Neueinstellung."
  727.   PRINT " Mit ";inv$;"POKE";norm$;" können Sie eine Speicherstelle, auch eine im Supervisor-Bereich!, verändern, wahlweise LONG-, WORD- oder BYTE-weise."
  728.   PRINT " ";inv$;"SHIP";norm$;" fährt einen der letzten Sektoren auf der letzten Partition Ihrer Festplatte an als Ersatz für ein reguläres PARK-Programm (&H1B an HD-Controller)."
  729.   PRINT " ";inv$;"WO laufw:+pfad+maske";norm$;" sucht auf dem angegebenen 'laufw' ab dem 'pfad' alle Dateien, die 'maske' entsprechen. 'laufw' und 'pfad' sind optional. In 'maske'"
  730.   PRINT "   stehen die üblichen Zeichen '*' und '?'."
  731.   PRINT " ";inv$;"ATTR datei";norm$;" gibt die Attribute einer Datei aus und gestattet diese zu ändern. Die Zeichen '*' und '?' sind in 'datei' erlaubt."
  732.   PRINT " ";inv$;"HOTKEY";norm$;" ändert die Kombination der Steuertasten, mit der SideKick.GFA aufgerufen wird. Bei allen Abfragen beläßt einfaches RETURN die alten Werte!"
  733.   PRINT "   Folgende Zahlenwerte gelten: RShift=01, LSchift=02, CTRL=04, ALT=08, CAPS=20,in HEX. GFABasic-Compilate liefern oft nicht die Steuertasten oder tätigen"
  734.   PRINT "   überhaupt keinen Aufruf an das AES. Dann läßt sich SideKick.GFA nicht aufrufen!"
  735.   PRINT " Die anderen, angezeigten Befehle sind noch nicht implementiert! Sorry."
  736.   PRINT
  737.   FOR b&=2 TO 15
  738.     IF drive!(b&) THEN
  739.       dd%=DFREE(b&+1)
  740.       IF CRSCOL>120 THEN
  741.         PRINT
  742.       ENDIF
  743.       PRINT " Drive ";inv$;CHR$(65+b&);norm$;":";STR$(dd%,8);" Bytes ";STR$(dd% DIV 1024,4);" KB ";STR$(dd%/1024/1024,4,2);" MB ";
  744.     ENDIF
  745.   NEXT b&
  746.   PRINT
  747.   PRINT
  748.   PRINT " SideKick.GFA ist ein Public-Domain-Programm! ";inv$;" Drücken Sie irgendeine Taste! ";norm$;" ";
  749.   x$=INPUT$(1)
  750.   PRINT
  751. RETURN ! hilfe
  752. PROCEDURE asc_tab
  753.   LOCAL i%
  754.   PRINT " Zeichen ";inv$;" ASC_II-Wert: Dec/Hex/Bin/Oct ";norm$
  755.   PRINT
  756.   FOR i%=0 TO 255
  757.     IF CRSCOL>140 THEN
  758.       PRINT
  759.     ENDIF
  760.     PRINT " ";
  761.     OUT 5,i%
  762.     PRINT " ";inv$;STR$(i%,3);norm$;" ";inv$;HEX$(i%,2);norm$;" ";inv$;BIN$(i%,8);norm$;" ";inv$;OCT$(i%,3);norm$;
  763.   NEXT i%
  764.   PRINT
  765. RETURN ! asc_tab
  766. '
  767. PROCEDURE bild_speichern
  768.   LOCAL w$,i%,j%,aus$,teil$,start%
  769.   PRINT " Bild speichern: ";inv$;"T";norm$;"T-Größe (153600 Bytes) oder 4x";inv$;"S";norm$;"T-Größe (32000 Bytes) ? ";
  770.   w$=UPPER$(INPUT$(1))
  771.   PRINT
  772.   IF w$="S" THEN
  773.     PRINT " Name der 4 ST-Bilder, um 1 Buchstaben gekürzt: ? ";
  774.     INPUT "",aus$
  775.     fehler!=FALSE
  776.     @check_drv(aus$)
  777.     @check_make(aus$)
  778.     @check_fre(aus$,160000)
  779.     IF NOT fehler! THEN
  780.       FOR i%=0 TO 3
  781.         teil$=aus$+STR$(i%,1)
  782.         OPEN "O",#1,teil$
  783.         start%=scrn_buf%
  784.         SELECT i%
  785.         CASE 0
  786.         CASE 1
  787.           ADD start%,80
  788.         CASE 2
  789.           ADD start%,399*160
  790.         CASE 3
  791.           ADD start%,399*160+80
  792.         ENDSELECT
  793.         FOR j%=0 TO 399
  794.           BPUT #1,start%+j%*160,80
  795.         NEXT j%
  796.         CLOSE #1
  797.       NEXT i%
  798.     ENDIF
  799.     fehler!=FALSE
  800.   ELSE
  801.     PRINT " Name des TT-Bildes ";
  802.     INPUT "",aus$
  803.     fehler!=FALSE
  804.     @check_drv(aus$)
  805.     @check_make(aus$)
  806.     @check_fre(aus$,155000)
  807.     IF NOT fehler! THEN
  808.       BSAVE aus$,scrn_buf%,153600
  809.     ENDIF
  810.     fehler!=FALSE
  811.   ENDIF
  812. RETURN ! bild_speichern
  813. PROCEDURE bild_laden
  814.   LOCAL in$,x$,i%
  815.   PRINT " Welche Datei ? ";
  816.   INPUT "",in$
  817.   fehler!=FALSE
  818.   @check_drv(in$)
  819.   IF NOT fehler! THEN
  820.     IF EXIST(in$) THEN
  821.       OPEN "I",#1,in$
  822.       l%=LOF(#1)
  823.       IF l%=32000 THEN
  824.         CLS
  825.         FOR i%=0 TO 399
  826.           BGET #1,XBIOS(2)+i%*160,80
  827.         NEXT i%
  828.         PRINT AT(1,26);
  829.       ELSE IF l%=153600
  830.         BGET #1,XBIOS(2),l%
  831.         x$=INPUT$(1)
  832.       ELSE
  833.       ENDIF
  834.       CLOSE #1
  835.     ENDIF
  836.     fehler!=FALSE
  837.   ENDIF
  838. RETURN ! bild_laden
  839. '
  840. PROCEDURE dir_change(in$)
  841.   IF in$="" THEN
  842.     PRINT inv$;" Aktuell:";norm$;drv$;":";path$;inv$;" Neues Directory ? ..\ ";norm$;" ";
  843.     INPUT "",in$
  844.   ENDIF
  845.   IF in$>"" THEN
  846.     fehler!=FALSE
  847.     @check_drv(in$)
  848.     IF NOT fehler! THEN
  849.       in$=in$+CHR$(0)
  850.       IF GEMDOS(&H3B,L:VARPTR(in$))=0 THEN
  851.         path$=DIR$(0)
  852.         @dir_anz("*.*")
  853.       ELSE
  854.         IF UPPER$(LEFT$(in$,1))<>drv$ THEN
  855.           PRINT inv$;" *** Pfad nur auf aktuellem Laufwerk einstellbar ! *** ";norm$;beep$
  856.         ELSE
  857.           PRINT inv$;" *** Pfad nicht gefunden ! *** ";norm$;beep$
  858.         ENDIF
  859.       ENDIF
  860.     ENDIF
  861.     fehler!=FALSE
  862.   ENDIF
  863. RETURN ! dir_change
  864. PROCEDURE drv_change(in$)
  865.   LOCAL a%
  866.   IF in$="" THEN
  867.     PRINT inv$;" Aktuell:";norm$;drv$;inv$;" Neues Laufwerk A..P ";norm$;" ";
  868.     INPUT "",in$
  869.   ENDIF
  870.   IF in$>"" THEN
  871.     fehler!=FALSE
  872.     @check_drv(in$)
  873.     IF NOT fehler! THEN
  874.       CHDRIVE in$
  875.       drv$=CHR$(65+GEMDOS(&H19))
  876.       path$=DIR$(0)
  877.       @dir_anz("\*.*")
  878.     ENDIF
  879.     fehler!=FALSE
  880.   ENDIF
  881. RETURN ! drv_change
  882. '
  883. PROCEDURE printer
  884.   LOCAL h$
  885.   IF prnt! THEN
  886.     prnt!=FALSE
  887.     CLOSE #3
  888.     PRINT " Wollen Sie MTSCHRFT.ASC ausdrucken lassen? j ";
  889.     IF UPPER$(INPUT$(1))="J" THEN
  890.       IF EXIST("MTSCHRFT.ASC") THEN
  891.         OPEN "I",#1,"MTSCHRFT.ASC"
  892.         WHILE NOT EOF(#1)
  893.           LINE INPUT #1,h$
  894.           LPRINT h$
  895.         WEND
  896.         CLOSE #1
  897.       ELSE
  898.         @melde("Konnte MTSCHRFT.ASC nicht finden!")
  899.         fehler!=FALSE
  900.       ENDIF
  901.     ENDIF
  902.   ELSE
  903.     IF EXIST("MTSCHRFT.ASC") THEN
  904.       OPEN "A",#3,"MTSCHRFT.ASC"
  905.       PRINT inv$;" Öffne MTSCHRFT.ASC und hänge die Protokoll-Daten an! ";norm$;beep$
  906.     ELSE
  907.       OPEN "O",#3,"MTSCHRFT.ASC"
  908.       PRINT inv$;" Öffne MTSCHRFT.ASC und trage die Protokoll-Daten ein! ";norm$;beep$
  909.     ENDIF
  910.     prnt!=TRUE
  911.   ENDIF
  912. RETURN ! printer
  913. PROCEDURE prnt(in$,lf!)
  914.   IF prnt! THEN
  915.     PRINT #3,in$;
  916.     IF lf! THEN
  917.       PRINT #3
  918.     ENDIF
  919.   ENDIF
  920. RETURN ! prnt
  921. '
  922. PROCEDURE dir_anz(in$)
  923.   LOCAL dta%,e%,attr%,len%,datum$,zeit$
  924.   IF in$="" OR RIGHT$(in$,1)=":" OR RIGHT$(in$)="\" THEN
  925.     in$=in$+"*.*"
  926.   ENDIF
  927.   IF INSTR(in$,".")=0 THEN
  928.     in$=in$+"\*.*"
  929.   ENDIF
  930.   fehler!=FALSE
  931.   @check_drv(in$)
  932.   IF NOT fehler! THEN
  933.     PRINT "DIR ";in$
  934.     PRINT STRING$(120,"-")
  935.     dta%=FGETDTA()
  936.     e%=FSFIRST(in$,-1)
  937.     DO
  938.       EXIT IF e%<>0
  939.       attr%=BYTE{dta%+21}
  940.       len%={dta%+26}
  941.       datum$=@dta_2_date$(INT{dta%+24})
  942.       zeit$=@dta_2_zeit$(INT{dta%+22})
  943.       IF CRSCOL>90 THEN
  944.         PRINT
  945.       ENDIF
  946.       IF attr% AND 16 THEN
  947.         PRINT inv$;"*";
  948.         @prnt("*",FALSE)
  949.       ELSE
  950.         PRINT norm$;" ";
  951.         @prnt(" ",FALSE)
  952.       ENDIF
  953.       PRINT LEFT$(CHAR{dta%+30}+"             ",14);STR$(len%,8);"/";HEX$(len%,6);" ";datum$;" ";zeit$;" ";BIN$(attr%,6);norm$;"  ";
  954.       @prnt(LEFT$(CHAR{dta%+30}+"             ",14)+STR$(len%,8)+"/"+HEX$(len%,6)+" "+datum$+" "+zeit$+" "+BIN$(attr%,6)+"  ",TRUE)
  955.       e%=FSNEXT()
  956.     LOOP
  957.     PRINT
  958.     PRINT norm$;STRING$(120,"-")
  959.   ENDIF
  960.   fehler!=FALSE
  961. RETURN ! dir_anz
  962. FUNCTION dta_2_date$(in&)
  963.   RETURN STR$(in& AND &X11111,2)+"."+STR$(SHR(in& AND &X111100000,5),2)+"."+STR$(1980+SHR(in& AND &X1111111000000000,9),4)
  964. ENDFUNC
  965. FUNCTION dta_2_zeit$(in&)
  966.   RETURN STR$(SHR(in& AND &X1111100000000000,11),2)+"."+STR$(SHR(in& AND &X11111100000,5),2)
  967. ENDFUNC
  968. '
  969. PROCEDURE md(in$)
  970.   IF in$="" THEN
  971.     PRINT " Name des NEUEN Directories? ";
  972.     INPUT "",in$
  973.   ENDIF
  974.   IF in$>"" THEN
  975.     MKDIR in$
  976.   ENDIF
  977. RETURN ! md
  978. PROCEDURE rd(in$)
  979.   IF in$="" THEN
  980.     PRINT " Welches VORHANDENE Directory wollen Sie LÖSCHEN ";
  981.     INPUT "",in$
  982.   ENDIF
  983.   IF in$>"" THEN
  984.     in$=in$+CHR$(0)
  985.     IF GEMDOS(&H3A,L:VARPTR(in$))<>0 THEN
  986.       PRINT inv$;" *** Directory konnte NICHT gelöscht werden! *** ";norm$;beep$
  987.     ENDIF
  988.   ENDIF
  989. RETURN ! rd
  990. '
  991. PROCEDURE s_maske(in$)
  992.   LOCAL p%,nam$,ext$,i%
  993.   wildcard!=FALSE
  994.   IF INSTR(in$,"?")>0 OR INSTR(in$,"*")>0 THEN
  995.     wildcard!=TRUE
  996.     ' Isolierung des eigentlichen Dateinamens
  997.     IF INSTR(in$,"\") THEN
  998.       s_startp%=RINSTR(in$,"\")+1
  999.     ELSE IF INSTR(in$,":")
  1000.       s_startp%=INSTR(in$,":")+1
  1001.     ELSE
  1002.       s_startp%=1
  1003.     ENDIF
  1004.     in$=TRIM$(MID$(in$,s_startp%,255))
  1005.     ' Aufteilung in NAME.EXT
  1006.     p%=INSTR(in$,".")
  1007.     IF p%>0 THEN
  1008.       nam$=LEFT$(in$,p%-1)
  1009.       ext$=MID$(in$,p%+1,3)
  1010.     ELSE
  1011.       nam$=LEFT$(in$,8)
  1012.       ext$=""
  1013.     ENDIF
  1014.     ' NAME scannen
  1015.     p%=INSTR(nam$,"*")
  1016.     IF p%>0 THEN
  1017.       nam$=LEFT$(LEFT$(nam$,p%-1)+"????????",8)
  1018.     ENDIF
  1019.     ' EXT scannen
  1020.     p%=INSTR(ext$,"*")
  1021.     IF p%>0 THEN
  1022.       ext$=LEFT$(LEFT$(ext$,p%-1)+"???",3)
  1023.     ENDIF
  1024.     ' Maske Setzen
  1025.     FOR i%=1 TO 8
  1026.       IF MID$(nam$,i%,1)="?" THEN
  1027.         s_nam_mask!(i%)=TRUE
  1028.       ELSE
  1029.         s_nam_mask!(i%)=FALSE
  1030.       ENDIF
  1031.     NEXT i%
  1032.     FOR i%=1 TO 3
  1033.       IF MID$(ext$,i%,1)="?" THEN
  1034.         s_ext_mask!(i%)=TRUE
  1035.       ELSE
  1036.         s_ext_mask!(i%)=FALSE
  1037.       ENDIF
  1038.     NEXT i%
  1039.   ENDIF
  1040. RETURN ! s_maske
  1041. FUNCTION d_maske$(h$,aus$)
  1042.   LOCAL i%,j%,old$,nam$,ext$,fuell_nam$,fuell_ext$,p%,f$
  1043.   IF wildcard! THEN
  1044.     ' Zerlegen des gefundenen Eintrags
  1045.     p%=INSTR(h$,".")
  1046.     IF p%>0 THEN
  1047.       nam$=LEFT$(h$,p%-1)
  1048.       ext$=MID$(h$,p%+1,3)
  1049.     ELSE
  1050.       nam$=h$
  1051.       ext$=""
  1052.     ENDIF
  1053.     fuell_nam$=""
  1054.     FOR p%=1 TO LEN(nam$)
  1055.       IF s_nam_mask!(p%) THEN
  1056.         fuell_nam$=fuell_nam$+MID$(nam$,p%,1)
  1057.       ENDIF
  1058.     NEXT p%
  1059.     fuell_ext$=""
  1060.     FOR p%=1 TO LEN(ext$)
  1061.       IF s_ext_mask!(p%) THEN
  1062.         fuell_ext$=fuell_ext$+MID$(ext$,p%,1)
  1063.       ENDIF
  1064.     NEXT p%
  1065.     '
  1066.     ' Isolierung des eigentlichen ZIEL-Dateinamens
  1067.     old$=aus$
  1068.     IF INSTR(aus$,"\") THEN
  1069.       d_startp%=RINSTR(aus$,"\")+1
  1070.     ELSE IF INSTR(aus$,":")
  1071.       d_startp%=INSTR(aus$,":")+1
  1072.     ELSE
  1073.       d_startp%=1
  1074.     ENDIF
  1075.     aus$=TRIM$(MID$(aus$,d_startp%,255))
  1076.     ' Aufteilung in NAME.EXT
  1077.     p%=INSTR(aus$,".")
  1078.     IF p%>0 THEN
  1079.       nam$=LEFT$(aus$,p%-1)
  1080.       ext$=MID$(aus$,p%+1,3)
  1081.     ELSE
  1082.       nam$=LEFT$(aus$,8)
  1083.       ext$=""
  1084.     ENDIF
  1085.     ' NAME scannen
  1086.     p%=INSTR(nam$,"*")
  1087.     IF p%>0 THEN
  1088.       nam$=LEFT$(LEFT$(nam$,p%-1)+"????????",8)
  1089.     ENDIF
  1090.     ' EXT scannen
  1091.     p%=INSTR(ext$,"*")
  1092.     IF p%>0 THEN
  1093.       ext$=LEFT$(LEFT$(ext$,p%-1)+"???",3)
  1094.     ENDIF
  1095.     ' Maske Setzen
  1096.     i%=0
  1097.     j%=1
  1098.     DO
  1099.       INC i%
  1100.       EXIT IF j%>LEN(fuell_nam$) OR i%>8
  1101.       IF MID$(nam$,i%,1)="?" THEN
  1102.         MID$(nam$,i%,1)=MID$(fuell_nam$,j%,1)
  1103.         INC j%
  1104.       ENDIF
  1105.     LOOP
  1106.     i%=INSTR(nam$,"?")
  1107.     IF i% THEN
  1108.       nam$=LEFT$(nam$,i%-1)
  1109.     ENDIF
  1110.     i%=0
  1111.     j%=1
  1112.     DO
  1113.       INC i%
  1114.       EXIT IF j%>LEN(fuell_ext$) OR i%>3
  1115.       IF MID$(ext$,i%,1)="?" THEN
  1116.         MID$(ext$,i%,1)=MID$(fuell_ext$,j%,1)
  1117.         INC j%
  1118.       ENDIF
  1119.     LOOP
  1120.     i%=INSTR(ext$,"?")
  1121.     IF i% THEN
  1122.       ext$=LEFT$(ext$,i%-1)
  1123.     ENDIF
  1124.     '
  1125.     f$=LEFT$(old$,d_startp%-1)+nam$+"."+ext$
  1126.     RETURN f$
  1127.   ELSE
  1128.     RETURN aus$
  1129.   ENDIF
  1130. ENDFUNC ! d_maske$
  1131. '
  1132. PROCEDURE kopiere(ren!,in$,weg!)
  1133.   LOCAL aus$,f$,w$,blks%,rest%,l%,b%,e%,dta%,h$,s_dir$,d_dir$,t$
  1134.   '
  1135.   ' Aufspaltung des Eingangs in Quell- und Zieldatei-Namen
  1136.   IF in$>"" THEN
  1137.     p%=INSTR(in$," ")
  1138.     IF p%>0 THEN
  1139.       aus$=TRIM$(MID$(in$,p%+1,255))
  1140.       in$=LEFT$(in$,p%-1)
  1141.     ELSE
  1142.       aus$=""
  1143.     ENDIF
  1144.   ELSE
  1145.     PRINT " Quelldatei ? ";
  1146.     INPUT "",in$
  1147.   ENDIF
  1148.   '
  1149.   ' Wurde ein Quelldatei-Name angegeben?
  1150.   IF in$>"" THEN
  1151.     fehler!=FALSE
  1152.     @check_drv(in$)
  1153.     '
  1154.     ' Kein falsches Drive in Quelldatei-Namen
  1155.     IF NOT fehler! THEN
  1156.       '
  1157.       ' Bestimmung der QuellDatei-Maske
  1158.       @s_maske(in$)
  1159.       s_dir$=@set_path$(in$)
  1160.       IF s_dir$<>"\" THEN
  1161.         s_dir$=s_dir$+"\"
  1162.       ENDIF
  1163.       p%=INSTR(s_dir$,"\\")
  1164.       IF p% THEN
  1165.         s_dir$=LEFT$(s_dir$,p%-1)+MID$(s_dir$,p%+1,255)
  1166.       ENDIF
  1167.       '
  1168.       ' Vorbereitung der Suche nach Wildcards
  1169.       dta%=FGETDTA()
  1170.       e%=FSFIRST(in$,-1)
  1171.       '
  1172.       ' Wurde wenigstens 1 Datei gefunden?
  1173.       IF e%<0 THEN
  1174.         PRINT inv$;" *** Keine Datei gefunden! *** ";norm$;beep$
  1175.         @set_path_org
  1176.         '
  1177.         ' Mindestens 1 Datei passt
  1178.       ELSE
  1179.         '
  1180.         ' Angabe des Zieldatei-Namens vergessen?
  1181.         IF aus$="" THEN
  1182.           PRINT
  1183.           PRINT " Zieldatei ? ";
  1184.           INPUT "",aus$
  1185.           aus$=TRIM$(UPPER$(aus$))
  1186.         ENDIF
  1187.         '
  1188.         ' Zieldatei-Name bekannt
  1189.         IF aus$>"" THEN !
  1190.           '
  1191.           ' Falsches Drive im Zieldatei-Namen?
  1192.           fehler!=FALSE
  1193.           @check_drv(f$)
  1194.           '
  1195.           ' Kein falsches Drive im Zieldatei-Namen
  1196.           IF NOT fehler! THEN
  1197.             '
  1198.             ' Suchschleife aufgrund FSFIRST(in$,-1)
  1199.             ' 1.Durchgang
  1200.             datein%=0
  1201.             fehler!=FALSE
  1202.             DO
  1203.               EXIT IF e%<0 OR fehler! ! Negative Fehlernummer
  1204.               INC datein%
  1205.               '
  1206.               ' Finde vollstaendigen Quelldatei-Namen
  1207.               h$=CHAR{dta%+30}
  1208.               s_file$(datein%)=s_dir$+h$
  1209.               '
  1210.               ' Finde vollstaendigen Zieldatei-Namen
  1211.               f$=@d_maske$(h$,aus$)
  1212.               d_dir$=@set_path$(f$)
  1213.               IF d_dir$<>"\" THEN
  1214.                 d_dir$=d_dir$+"\"
  1215.               ENDIF
  1216.               IF INSTR(f$,":") THEN
  1217.                 d_dir$=""
  1218.               ELSE IF INSTR(f$,"\")
  1219.                 d_dir$=LEFT$(d_dir$,2)
  1220.               ELSE
  1221.               ENDIF
  1222.               d_file$(datein%)=d_dir$+f$
  1223.               t$=@set_path$(in$)
  1224.               '
  1225.               IF s_file$(datein%)=d_file$(datein%) THEN
  1226.                 @melde("Übereinstimmung zwischen Quell- und Zieldatei-Namen")
  1227.               ENDIF
  1228.               '
  1229.               IF ren! THEN
  1230.                 IF LEFT$(s_file$(datein%),1)<>LEFT$(d_file$(datein%),1) THEN
  1231.                   @melde("RENAME nur auf ein und demselben Laufwerk!")
  1232.                 ENDIF
  1233.               ENDIF
  1234.               '
  1235.               IF datein%>fnams% THEN
  1236.                 @melde("Kopierroutine ist auf "+norm$+STR$(fnams%)+inv$+" Dateien beschränkt")
  1237.               ENDIF
  1238.               '
  1239.               e%=FSNEXT()
  1240.             LOOP
  1241.             @set_path_org
  1242.             '
  1243.             ' Fehler im 1.Durchgang aufgetaucht?
  1244.             IF NOT fehler ! then
  1245.               '
  1246.               ' 2.Durchgang
  1247.               FOR e%=1 TO datein%
  1248.                 '
  1249.                 ' Anzeige fuer den Benutzer
  1250.                 PRINT inv$;
  1251.                 IF ren! THEN
  1252.                   PRINT " RENAME ";
  1253.                 ELSE
  1254.                   IF weg! THEN
  1255.                     PRINT " MOVE ";
  1256.                   ELSE
  1257.                     PRINT " COPY ";
  1258.                   ENDIF
  1259.                 ENDIF
  1260.                 PRINT norm$;s_file$(e%);inv$;" TO ";norm$;d_file$(e%)
  1261.                 '
  1262.                 ' Zieldatei bereits vorhanden?
  1263.                 w$="J"
  1264.                 IF EXIST(d_file$(e%)) THEN
  1265.                   PRINT
  1266.                   PRINT " ";d_file$(e%);" ";inv$;" existiert bereits, dennoch Kopieren/Umbenennen ? [J,j,..] ";norm$;" "
  1267.                   w$=UPPER$(CHR$(GEMDOS(7)))
  1268.                   '
  1269.                   ' Im RENAME-Modus: DEL
  1270.                   IF ren! AND w$="J" THEN
  1271.                     KILL d_file$(e%)
  1272.                   ENDIF
  1273.                   '
  1274.                 ENDIF
  1275.                 '
  1276.                 ' Kopiere
  1277.                 IF w$="J" THEN
  1278.                   '
  1279.                   ' RENAME ?
  1280.                   IF ren! THEN
  1281.                     NAME s_file$(e%) AS d_file$(e%)
  1282.                     '
  1283.                     ' COPY/MOVE
  1284.                   ELSE
  1285.                     '
  1286.                     OPEN "I",#1,s_file$(e%)
  1287.                     l%=LOF(#1)
  1288.                     '
  1289.                     ' Reicht Diskettenplatz?
  1290.                     fehler!=FALSE
  1291.                     @check_make(d_file$(e%))
  1292.                     @check_fre(d_file$(e%),l%)
  1293.                     '
  1294.                     ' Diskettenplatz reicht
  1295.                     IF NOT fehler! THEN
  1296.                       OPEN "O",#2,d_file$(e%)
  1297.                       blks%=l% DIV 32768
  1298.                       rest%=l% MOD 32768
  1299.                       IF blks%>0 THEN
  1300.                         FOR b%=1 TO blks%
  1301.                           BGET #1,kop_buf%,32768
  1302.                           BPUT #2,kop_buf%,32768
  1303.                         NEXT b%
  1304.                       ENDIF ! blks%>0
  1305.                       IF rest%>0 THEN
  1306.                         BGET #1,kop_buf%,rest%
  1307.                         BPUT #2,kop_buf%,rest%
  1308.                       ENDIF ! rest%>0
  1309.                       CLOSE #1
  1310.                       CLOSE #2
  1311.                       '
  1312.                       ' MOVE ?
  1313.                       IF weg! THEN
  1314.                         KILL s_file$(e%)
  1315.                       ENDIF ! weg!
  1316.                       '
  1317.                     ELSE ! Kein ausreichender Platz
  1318.                       CLOSE #1
  1319.                     ENDIF ! NOT fehler! = Platz reicht nicht
  1320.                   ENDIF ! ren! = RENAME oder COPY/MOVE ?
  1321.                 ENDIF ! w$="J" = (Trotzdem) Kopieren
  1322.               NEXT e%
  1323.             ENDIF ! NOT fehler! = Fehler in der Suchschleife, 1.Durchgang
  1324.           ENDIF ! NOT fehler! = Drive-Angabe in Zieldatei-Namen
  1325.         ENDIF ! aus$>"" = Zieldatei-Name vorhanden
  1326.       ENDIF ! e%<0 = Mindestens 1 Datei gefunden
  1327.     ENDIF ! NOT fehler! = Drive-Angabe in Quelldatei-Namen
  1328.     fehler!=FALSE
  1329.     @set_path_org
  1330.   ENDIF ! in$>""
  1331. RETURN ! kopiere
  1332. FUNCTION set_path$(in$)
  1333.   LOCAL p%,temp_drive%,temp_path$,back!,t$,dr$
  1334.   ' ALERT 1,"in:'"+in$+"'",1,"R",d%
  1335.   dr$=CHR$(GEMDOS(&H19)+65)
  1336.   p%=INSTR(in$,":")
  1337.   back!=FALSE
  1338.   IF p%=2 THEN
  1339.     temp_drive%=ASC(LEFT$(in$,1))-65
  1340.     IF temp_drive%<0 OR temp_drive%>15 THEN
  1341.       @melde("Source-Drive nicht möglich")
  1342.     ELSE
  1343.       IF NOT drive!(temp_drive%) THEN
  1344.         @melde("Source-Drive nicht angemeldet")
  1345.       ELSE
  1346.         ~GEMDOS(&HE,temp_drive%)
  1347.         dr$=CHR$(GEMDOS(&H19)+65)
  1348.         back!=TRUE
  1349.       ENDIF
  1350.     ENDIF
  1351.     in$=MID$(in$,3,255)
  1352.   ELSE IF p%>0
  1353.     fehler!=TRUE
  1354.     in$=""
  1355.   ELSE
  1356.     ' Kein anderes Laufwerk
  1357.   ENDIF
  1358.   IF NOT fehler! THEN
  1359.     IF INSTR(in$,"\") THEN
  1360.       temp_path$=LEFT$(in$,RINSTR(in$,"\"))
  1361.       IF back! AND LEFT$(temp_path$,1)<>"\" THEN
  1362.         temp_path$="\"+temp_path$
  1363.       ENDIF
  1364.       t$=temp_path$+CHR$(0)
  1365.       IF GEMDOS(&H3B,L:VARPTR(t$))<>0 THEN
  1366.         @melde("Source-Path nicht gefunden")
  1367.         RETURN dr$+":"+path$
  1368.       ELSE
  1369.         RETURN dr$+":"+temp_path$
  1370.       ENDIF
  1371.     ELSE
  1372.       CHDRIVE drv$
  1373.       CHDIR path$
  1374.       RETURN dr$+":"+path$
  1375.     ENDIF
  1376.   ELSE
  1377.     RETURN dr$+":"+path$
  1378.   ENDIF
  1379. ENDFUNC! set_path$(in$)
  1380. PROCEDURE set_path_org
  1381.   CHDRIVE drv$
  1382.   CHDIR path$
  1383. RETURN ! set_path_org
  1384. '
  1385. PROCEDURE neu_hot_key
  1386.   LOCAL t%,w$
  1387.   PRINT inv$;" Bisher: $";HEX$(hot_key%,8);" [";hot_key$;"] Ihre NEUE Tastenkombination: ? ";norm$;
  1388.   PRINT "  RShift=01,LSchift=02,CTRL=04,ALT=08,CAPS=20,in HEX"
  1389.   PRINT " Geben Sie nun den Wert (in HEX wie dargestellt) ein: ";
  1390.   INPUT "",w$
  1391.   IF w$>"" THEN
  1392.     hot_key%=VAL("&H"+w$)
  1393.   ENDIF
  1394.   PRINT inv$;" Mit welchem NEUEN BEZEICHNER wird diese Kombination '$";HEX$(hot_key%,8);"' belegt: ";norm$
  1395.   INPUT "",w$
  1396.   IF w$>"" THEN
  1397.     hot_key$=w$
  1398.   ENDIF
  1399. RETURN ! neu_hot_key
  1400. '
  1401. PROCEDURE quasi_ship
  1402.   LOCAL x$
  1403.   ~C:dark_l%(L:XBIOS(2),L:153600 DIV 4)
  1404.   IF BIOS(4,2,L:kop_buf%,1,end_sector%,end_drive%)=0 THEN
  1405.     PRINT AT(1,1);inv$;"  *** Sektor ";end_sector%;" auf Partition ";CHR$(end_drive%+65);":\ angefahren! AUSSCHALTEN *** ";norm$
  1406.     x$=INPUT$(1)
  1407.   ELSE
  1408.     PRINT " ";inv$;" *** Konnte Quasi-SHIP nicht ausführen! *** ";norm$;beep$
  1409.   ENDIF
  1410. RETURN ! ship
  1411. '
  1412. PROCEDURE state
  1413.   LOCAL st%,tt%
  1414.   PRINT " SideKick hat noch ";FRE(0);" Bytes"
  1415.   st%=GEMDOS(&H44,L:-1,0)
  1416.   tt%=GEMDOS(&H44,L:-1,1)
  1417.   PRINT " ST-RAM:";STR$(st%,8);" Bytes ";STR$(st% DIV 1024,4);" KB ";STR$(st%/1024/1024,4,2);" MB"
  1418.   PRINT " TT-RAM:";STR$(tt%,8);" Bytes ";STR$(tt% DIV 1024,4);" KB ";STR$(tt%/1024/1024,4,2);" MB"
  1419.   PRINT
  1420. RETURN ! state
  1421. '
  1422. PROCEDURE show_asc(in$)
  1423.   LOCAL w$,h$
  1424.   IF in$="" THEN
  1425.     PRINT " Welche Datei? ";
  1426.     INPUT "",in$
  1427.   ENDIF
  1428.   IF in$>"" THEN
  1429.     fehler!=FALSE
  1430.     @check_drv(in$)
  1431.     IF NOT fehler! THEN
  1432.       IF EXIST(in$) THEN
  1433.         OPEN "I",#1,in$
  1434.         CLS
  1435.         w$=""
  1436.         WHILE (NOT EOF(#1)) AND (w$<>"X")
  1437.           IF CRSLIN>=58 THEN
  1438.             PRINT
  1439.             PRINT inv$;" Drücken Sie irgendeine Taste! ('X' bricht ab!) ";norm$;" ";
  1440.             w$=UPPER$(INPUT$(1))
  1441.             IF w$<>"X" THEN
  1442.               CLS
  1443.             ENDIF
  1444.           ENDIF
  1445.           IF CRSCOL>150 THEN
  1446.             PRINT
  1447.           ELSE
  1448.             PRINT INPUT$(1,#1);
  1449.           ENDIF
  1450.         WEND
  1451.         CLOSE #1
  1452.       ELSE
  1453.         PRINT
  1454.         PRINT inv$;in$;" war nicht zu finden!";norm$;beep$
  1455.       ENDIF
  1456.     ENDIF
  1457.     fehler!=FALSE
  1458.   ENDIF
  1459. RETURN ! show_asc
  1460. '
  1461. PROCEDURE hex_dump(in$)
  1462.   LOCAL w$,h$,l%,blks%,rest%,b%,z%
  1463.   IF in$="" THEN
  1464.     PRINT " Welche Datei? ";
  1465.     INPUT "",in$
  1466.   ENDIF
  1467.   IF in$>"" THEN
  1468.     fehler!=FALSE
  1469.     @check_drv(in$)
  1470.     IF NOT fehler! THEN
  1471.       IF EXIST(in$) THEN
  1472.         OPEN "I",#1,in$
  1473.         l%=LOF(#1)
  1474.         blks%=l% DIV 32
  1475.         rest%=l% MOD 32
  1476.         CLS
  1477.         z%=0
  1478.         w$=""
  1479.         IF blks%>0 THEN
  1480.           b%=0
  1481.           DO
  1482.             INC b%
  1483.             EXIT IF b%>blks% OR w$="X"
  1484.             IF CRSLIN>=59 THEN
  1485.               PRINT inv$;" Drücken Sie irgendeine Taste! ('X' bricht ab!) ";norm$;" ";
  1486.               w$=UPPER$(INPUT$(1))
  1487.               IF w$<>"X" THEN
  1488.                 CLS
  1489.               ENDIF
  1490.             ENDIF
  1491.             PRINT inv$;HEX$(z%,6);norm$;": ";
  1492.             @prnt(HEX$(z%,6)+": ",FALSE)
  1493.             ADD z%,32
  1494.             h$=INPUT$(32,#1)
  1495.             @hex32(h$)
  1496.           LOOP
  1497.         ENDIF
  1498.         IF rest%>0 AND w$<>"X" THEN
  1499.           PRINT inv$;HEX$(z%,6);norm$;": ";
  1500.           @prnt(HEX$(z%,6)+": ",FALSE)
  1501.           h$=INPUT$(rest%,#1)
  1502.           @hex32(h$)
  1503.         ENDIF
  1504.         CLOSE #1
  1505.       ELSE
  1506.         PRINT
  1507.         PRINT inv$;in$;" war nicht zu finden!";norm$
  1508.       ENDIF
  1509.     ENDIF
  1510.     fehler!=FALSE
  1511.   ENDIF
  1512. RETURN ! hex_dump
  1513. PROCEDURE mem_dump(in$)
  1514.   LOCAL w$,adr%,sp$,c%,w%
  1515.   sp$=SPACE$(32)
  1516.   IF in$="" THEN
  1517.     PRINT inv$;" Ab welcher Adresse? (Dezimal bitte mit führendem 'd'!) ";norm$;" ";
  1518.     INPUT "",in$
  1519.   ENDIF
  1520.   IF LEFT$(in$,1)="d" THEN
  1521.     adr%=VAL(RIGHT$(in$,LEN(in$)-1))
  1522.   ELSE
  1523.     adr%=VAL("&H"+in$)
  1524.   ENDIF
  1525.   IF adr%>-1 THEN
  1526.     IF ODD(adr%) THEN
  1527.       DEC adr%
  1528.     ENDIF
  1529.     w$=""
  1530.     CLS
  1531.     DO
  1532.       IF CRSLIN>=59 THEN
  1533.         PRINT inv$;" Drücken Sie irgendeine Taste! ('X' bricht ab!) ";norm$;" ";
  1534.         w$=UPPER$(INPUT$(1))
  1535.         IF w$<>"X" THEN
  1536.           CLS
  1537.         ENDIF
  1538.       ENDIF
  1539.       EXIT IF w$="X"
  1540.       PRINT inv$;HEX$(adr%,6);norm$;": ";
  1541.       @prnt(HEX$(adr%,6)+": ",FALSE)
  1542.       w%=V:sp$
  1543.       FOR c%=0 TO 31 STEP 4
  1544.         {ADD(w%,c%)}=LPEEK(ADD(adr%,c%))
  1545.       NEXT c%
  1546.       ADD adr%,32
  1547.       @hex32(sp$)
  1548.     LOOP
  1549.   ENDIF
  1550. RETURN ! mem_dump
  1551. PROCEDURE disk_mon(in$)
  1552.   LOCAL sect%,w$,dr%,sp$,z%,s%
  1553.   IF in$="" THEN
  1554.     PRINT " Suche ab Sektor (in HEX!) ";
  1555.     INPUT "",in$
  1556.   ENDIF
  1557.   IF in$>"" THEN
  1558.     IF LEFT$(in$,1)="d" THEN
  1559.       sect%=VAL(RIGHT$(in$,LEN(in$)-1))
  1560.     ELSE
  1561.       sect%=VAL("&H"+in$)
  1562.     ENDIF
  1563.     IF sect%>-1 THEN
  1564.       dr%=GEMDOS(&H19)
  1565.       w$=""
  1566.       DO
  1567.         sp$=STRING$(32,CHR$(0))
  1568.         IF BIOS(4,2,L:kop_buf%,3,sect%,dr%)<>0 THEN
  1569.           PRINT " ";inv$;" *** ERROR RWAbs *** ";norm$
  1570.         ENDIF
  1571.         s%=sect%
  1572.         FOR z%=0 TO 47
  1573.           IF ((z%) MOD 16)=0 THEN
  1574.             PRINT " Sektor = $";HEX$(sect%)
  1575.             @prnt("Sektor = $"+HEX$(sect%),TRUE)
  1576.             INC sect%
  1577.           ENDIF
  1578.           PRINT inv$;HEX$(ADD(SHL(z%,5),SHL(s%,9)),8);norm$;": ";
  1579.           @prnt(HEX$(ADD(SHL(z%,5),SHL(s%,9)),8)+": ",FALSE)
  1580.           BMOVE ADD(kop_buf%,SHL(z%,5)),V:sp$,32
  1581.           @hex32(sp$)
  1582.         NEXT z%
  1583.         PRINT inv$;" Abbrechen mit 'X' ";norm$;" ";
  1584.         w$=UPPER$(INPUT$(1))
  1585.         PRINT
  1586.         EXIT IF w$="X"
  1587.       LOOP
  1588.     ENDIF
  1589.   ENDIF
  1590. RETURN ! disk_mon
  1591. PROCEDURE hex32(in$)
  1592.   LOCAL c%,w$,l%
  1593.   l%=LEN(in$)
  1594.   FOR c%=1 TO l%
  1595.     PRINT HEX$(ASC(MID$(in$,c%,1)),2);" ";
  1596.     @prnt(HEX$(ASC(MID$(in$,c%,1)),2)+" ",FALSE)
  1597.     IF (c% MOD 4)=0 THEN
  1598.       PRINT " ";
  1599.       @prnt(" ",FALSE)
  1600.     ENDIF
  1601.   NEXT c%
  1602.   PRINT inv$;
  1603.   FOR c%=1 TO l%
  1604.     w$=MID$(in$,c%,1)
  1605.     IF w$>CHR$(31) AND w$<CHR$(127) THEN
  1606.       PRINT w$;
  1607.       @prnt(w$,FALSE)
  1608.     ELSE
  1609.       PRINT ".";
  1610.       @prnt(".",FALSE)
  1611.     ENDIF
  1612.   NEXT c%
  1613.   PRINT norm$
  1614.   @prnt("",TRUE)
  1615. RETURN ! hex32
  1616. '
  1617. PROCEDURE such_2_strng
  1618.   LOCAL wandel$,i%,w%
  1619.   wandel$=HEX$(such%)
  1620.   IF ODD(LEN(wandel$)) THEN
  1621.     wandel$="0"+wandel$
  1622.   ENDIF
  1623.   such$=""
  1624.   FOR i%=1 TO LEN(wandel$) STEP 2
  1625.     w%=VAL("&H"+MID$(wandel$,i%,2))
  1626.     such$=such$+CHR$(w%)
  1627.   NEXT i%
  1628.   PRINT
  1629.   PRINT " Suche nach: ";
  1630.   FOR i%=1 TO LEN(such$)
  1631.     PRINT HEX$(ASC(MID$(such$,i%,1)),2);" ";
  1632.   NEXT i%
  1633.   PRINT
  1634.   such%=0
  1635. RETURN ! such_2_strng
  1636. PROCEDURE find_in_mem
  1637.   LOCAL fundstelle%
  1638.   IF such$="" THEN
  1639.     @such_2_strng
  1640.   ENDIF
  1641.   IF ODD(sstart%) THEN
  1642.     DEC sstart%
  1643.   ENDIF
  1644.   IF sstart%>LPEEK(&H42E) THEN
  1645.     PRINT inv$;" *** Supervisor-Bereich, Keine Suche möglich! *** ";norm$;beep$
  1646.   ELSE IF sstart%<2048
  1647.     FOR i%=0 TO 2047 STEP 4
  1648.       {kop_buf%+i%}=LPEEK(i%)
  1649.     NEXT i%
  1650.     fundstelle%=C:thhust%(L:kop_buf%+sstart%,L:2047,L:VARPTR(such$),L:LEN(such$),0)
  1651.     IF fundstelle%=0 THEN
  1652.       sstart%=2048
  1653.       fundstelle%=C:thhust%(L:sstart%,L:LPEEK(&H42E)-sstart%-1,L:VARPTR(such$),L:LEN(such$),0)
  1654.     ELSE
  1655.     ENDIF
  1656.   ELSE
  1657.     fundstelle%=C:thhust%(L:sstart%,L:LPEEK(&H42E)-sstart%-1,L:VARPTR(such$),L:LEN(such$),0)
  1658.   ENDIF
  1659.   IF fundstelle%>0 THEN
  1660.     ADD fundstelle%,sstart%-1
  1661.     @mem_dump(HEX$(fundstelle%))
  1662.   ELSE
  1663.     PRINT " Nicht gefunden! ";beep$
  1664.   ENDIF
  1665. RETURN ! find_in_mem
  1666. PROCEDURE find_in_file
  1667.   LOCAL in$,l%,blks%,rest%,b%,fundstelle%,found!,err!,w$,y%,z%,h$
  1668.   PRINT
  1669.   PRINT " Welche Datei? ";
  1670.   FORM INPUT 120 AS suchfile$
  1671.   in$=suchfile$
  1672.   fehler!=FALSE
  1673.   @check_drv(in$)
  1674.   IF NOT fehler! THEN
  1675.     IF EXIST(in$) THEN
  1676.       IF such$="" THEN
  1677.         @such_2_strng
  1678.       ENDIF
  1679.       PRINT
  1680.       y%=CRSLIN
  1681.       OPEN "I",#1,in$
  1682.       l%=LOF(#1)
  1683.       IF sstart%<l% THEN
  1684.         SEEK #1,sstart%
  1685.       ENDIF
  1686.       SUB l%,sstart%
  1687.       blks%=l% DIV 32768
  1688.       rest%=l% MOD 32768
  1689.       w$=""
  1690.       found!=FALSE
  1691.       IF blks%>0 THEN
  1692.         b%=0
  1693.         DO
  1694.           INC b%
  1695.           PRINT AT(1,y%);STR$(ADD(SHL(SUB(b%,1),15),sstart%),8);" Bytes";
  1696.           EXIT IF b%>blks% OR w$="X"
  1697.           BGET #1,kop_buf%,32768
  1698.           fundstelle%=C:thhust%(L:kop_buf%,L:32768,L:VARPTR(such$),L:LEN(such$),0)
  1699.           IF fundstelle%>0 THEN
  1700.             found!=TRUE
  1701.             ADD sstart%,(b%-1)*32768+fundstelle%-1
  1702.           ENDIF
  1703.           EXIT IF found!
  1704.           w$=UPPER$(INKEY$)
  1705.         LOOP
  1706.       ENDIF
  1707.       IF rest%>0 AND (NOT found!) THEN
  1708.         BGET #1,kop_buf%,rest%
  1709.         fundstelle%=C:thhust%(L:kop_buf%,L:rest%,L:VARPTR(such$),L:LEN(such$),0)
  1710.         IF fundstelle%>0 THEN
  1711.           found!=TRUE
  1712.           ADD sstart%,(b%-1)*32768+fundstelle%-1
  1713.         ENDIF
  1714.       ENDIF
  1715.       CLOSE #1
  1716.       PRINT
  1717.       IF found! THEN
  1718.         OPEN "I",#1,in$
  1719.         l%=LOF(#1)
  1720.         IF ODD(sstart%) THEN
  1721.           DEC sstart%
  1722.         ENDIF
  1723.         SEEK #1,sstart%
  1724.         SUB l%,sstart%
  1725.         blks%=l% DIV 32
  1726.         rest%=l% MOD 32
  1727.         CLS
  1728.         z%=0
  1729.         w$=""
  1730.         IF blks%>0 THEN
  1731.           b%=0
  1732.           DO
  1733.             INC b%
  1734.             EXIT IF b%>blks% OR w$="X"
  1735.             IF CRSLIN>=59 THEN
  1736.               PRINT inv$;" Drücken Sie irgendeine Taste! ('X' bricht ab!) ";norm$;" ";
  1737.               w$=UPPER$(INPUT$(1))
  1738.               IF w$<>"X" THEN
  1739.                 CLS
  1740.               ENDIF
  1741.             ENDIF
  1742.             PRINT inv$;HEX$(z%+sstart%,6);norm$;": ";
  1743.             @prnt(HEX$(z%+sstart%,6)+": ",FALSE)
  1744.             ADD z%,32
  1745.             h$=INPUT$(32,#1)
  1746.             @hex32(h$)
  1747.           LOOP
  1748.         ENDIF
  1749.         IF rest%>0 AND w$<>"X" THEN
  1750.           PRINT inv$;HEX$(z%,6);norm$;": ";
  1751.           @prnt(HEX$(z%,6)+": ",FALSE)
  1752.           h$=INPUT$(rest%,#1)
  1753.           @hex32(h$)
  1754.         ENDIF
  1755.         CLOSE #1
  1756.       ENDIF
  1757.     ELSE
  1758.       PRINT inv$;" *** Datei nicht vorhanden! *** ";norm$;beep$
  1759.     ENDIF
  1760.     fehler!=FALSE
  1761.   ENDIF
  1762. RETURN ! find_in_file
  1763. PROCEDURE find_on_disk
  1764.   LOCAL sect%,ferr!,found!,y%,w$,fundstelle%
  1765.   IF such$="" THEN
  1766.     @such_2_strng
  1767.   ENDIF
  1768.   PRINT
  1769.   dr%=GEMDOS(&H19)
  1770.   sect%=sstart%
  1771.   ferr!=FALSE
  1772.   found!=FALSE
  1773.   y%=CRSLIN
  1774.   w$=""
  1775.   DO
  1776.     PRINT AT(1,y%);" Sektor: ";STR$(sect%,8);"=&H";HEX$(sect%,7);"=";SHL(sect%,9);
  1777.     IF BIOS(4,2,L:kop_buf%,64,sect%,dr%)<>0 THEN
  1778.       @melde("RWAbsolute fehlgeschlagen")
  1779.       ferr!=TRUE
  1780.     ENDIF
  1781.     fundstelle%=C:thhust%(L:kop_buf%,L:32768,L:VARPTR(such$),L:LEN(such$),0)
  1782.     w$=UPPER$(INKEY$)
  1783.     IF fundstelle%>0 THEN
  1784.       found!=TRUE
  1785.       ADD sect%,fundstelle% DIV 512
  1786.     ENDIF
  1787.     EXIT IF found! OR ferr! OR w$="X"
  1788.     ADD sect%,64
  1789.   LOOP
  1790.   PRINT
  1791.   IF found! THEN
  1792.     @disk_mon(HEX$(sect%))
  1793.   ENDIF
  1794. RETURN ! find_on_disk
  1795. '
  1796. PROCEDURE cluster(in$)
  1797.   fehler!=FALSE
  1798.   IF in$="" THEN
  1799.     PRINT " ";inv$;" Name der Datei ";norm$;" ? ";
  1800.     INPUT "",in$
  1801.     in$=TRIM$(UPPER$(in$))
  1802.   ENDIF
  1803.   IF in$>"" THEN
  1804.     IF EXIST(in$) THEN
  1805.       PRINT
  1806.       @clust_drive(in$)
  1807.       @to_dir(in$)
  1808.     ELSE
  1809.       @melde("Datei "+in$+" nicht gefunden")
  1810.     ENDIF
  1811.   ENDIF
  1812. RETURN ! clust
  1813. PROCEDURE clust_drive(nam$)
  1814.   IF NOT fehler! THEN
  1815.     IF MID$(nam$,2,1)=":" THEN
  1816.       CHDRIVE LEFT$(nam$,1)
  1817.     ENDIF
  1818.     drv%=GEMDOS(&H19)
  1819.     BMOVE BIOS(7,drv%),bpb%,18
  1820.     sectsize%=bpb&(0)
  1821.     fat%=bpb&(5)
  1822.     fatsize%=bpb&(4)
  1823.     IF fatsize%*sectsize%>32768 THEN
  1824.       @melde("FAT zu groß")
  1825.     ENDIF
  1826.     root%=fat%+fatsize%
  1827.     rootsize%=2 ! Nur 1 Cluster mit 30 Einträgen!
  1828.     offset%=bpb&(6)
  1829.     IF (bpb&(8) AND 1)=0 THEN
  1830.       @melde("Nur 16-Bit-FAT erlaubt")
  1831.     ENDIF
  1832.     IF NOT fehler! THEN
  1833.       ~BIOS(4,2,L:kop_buf%,fatsize%,fat%,drv%)
  1834.       ~BIOS(4,2,L:ddir_buf%,rootsize%,root%,drv%)
  1835.     ENDIF
  1836.   ENDIF
  1837. RETURN ! clust_drive
  1838. PROCEDURE to_dir(nam$)
  1839.   LOCAL p%,t_path$
  1840.   IF NOT fehler! THEN
  1841.     DO
  1842.       p%=INSTR(nam$,"\")
  1843.       EXIT IF p%=0 OR fehler!
  1844.       INC p%
  1845.       nam$=MID$(nam$,p%,255)
  1846.       p%=INSTR(nam$,"\")
  1847.       IF p% THEN
  1848.         t_path$=LEFT$(nam$,p%-1)
  1849.         PRINT " Path: '";t_path$;"'"
  1850.         nam$=MID$(nam$,p%+1,255)
  1851.         @find_in_dir(t_path$)
  1852.       ENDIF
  1853.     LOOP
  1854.     PRINT " Datei: '";nam$;"'"
  1855.     @nam_normalisierung(nam$)
  1856.     @find_first_clust(nam$)
  1857.   ENDIF
  1858. RETURN ! to_dir
  1859. PROCEDURE find_in_dir(p$)
  1860.   LOCAL fundstelle%,a%,sect%,clust%
  1861.   IF NOT fehler! THEN
  1862.     fundstelle%=C:thhust%(L:ddir_buf%,L:rootsize%*sectsize%,L:VARPTR(p$),L:LEN(p$),0)-1
  1863.     IF fundstelle%=-1 THEN
  1864.       @melde("Pfad "+p$+" nicht auffindbar, nur 32 Einträge")
  1865.       @show(ddir_buf%,ddir_buf%+1023)
  1866.     ELSE
  1867.       a%=ddir_buf%+fundstelle%
  1868.       ADD a%,26 ! 1.Cluster des neuen Directories
  1869.       clust%=BYTE{a%}+256*BYTE{a%+1}
  1870.       sect%=offset%+2*clust%-4
  1871.       rootsize%=2 ! Pfui, nur 32 Einträge im Directory damit erfasst!
  1872.       ~BIOS(4,2,L:ddir_buf%,rootsize%,sect%,drv%)
  1873.     ENDIF
  1874.   ENDIF
  1875. RETURN ! find_in_dir
  1876. PROCEDURE nam_normalisierung(VAR f$)
  1877.   LOCAL p%
  1878.   p%=INSTR(f$,".")
  1879.   IF p% THEN
  1880.     f$=LEFT$(LEFT$(f$,p%-1)+"        ",8)+LEFT$(MID$(f$,p%+1,3)+"   ",3)
  1881.   ENDIF
  1882. RETURN ! punkt_weg
  1883. PROCEDURE find_first_clust(f$)
  1884.   LOCAL a%,fundstelle%,clust%,sect%,fat_start%,x$
  1885.   IF NOT fehler! THEN
  1886.     fundstelle%=C:thhust%(L:ddir_buf%,L:rootsize%*sectsize%,L:VARPTR(f$),L:LEN(f$),0)-1
  1887.     IF fundstelle%=-1 THEN
  1888.       @melde("Datei "+f$+" nicht auffindbar. Nur 32 Einträge")
  1889.       @show(ddir_buf%,ddir_buf%+1023)
  1890.     ELSE
  1891.       a%=ddir_buf%+fundstelle%
  1892.       ADD a%,26 ! 1.Cluster der Datei
  1893.       clust%=BYTE{a%}+256*BYTE{a%+1}
  1894.       sect%=offset%+2*clust%-4
  1895.       fat_start%=clust%*2
  1896.       PRINT " Die Datei ";f$;" beginnt bei Cluster $";HEX$(clust%);", bei Sektor (BIOS 4) $";HEX$(sect%);", in der FAT bei FAT+$";
  1897.       PRINT HEX$(fat_start%);" = $";HEX$(fat_start%+fat%*sectsize%)
  1898.       @cluster_ausgabe(clust%)
  1899.       @grafik(clust%)
  1900.     ENDIF
  1901.   ENDIF
  1902. RETURN ! find_first_clust
  1903. PROCEDURE cluster_ausgabe(s%)
  1904.   LOCAL a%,nxt%,sum%,w$
  1905.   IF NOT fehler! THEN
  1906.     PRINT " ";inv$;" Cluster-Nummern in HEX ";norm$
  1907.     PRINT HEX$(s%,4);" ";
  1908.     a%=kop_buf%+s%*2
  1909.     sum%=1
  1910.     w$=""
  1911.     DO
  1912.       nxt%=BYTE{a%}+256*BYTE{a%+1}
  1913.       EXIT IF nxt%=&HFFFF OR w$="X" ! Ende der FAT-Schnur
  1914.       IF CRSCOL>154 THEN
  1915.         PRINT
  1916.         @prnt("",TRUE)
  1917.       ENDIF
  1918.       IF CRSLIN>=58 THEN
  1919.         PRINT
  1920.         PRINT inv$;" Press a Key! ";norm$;" ";
  1921.         w$=UPPER$(INPUT$(1))
  1922.         CLS
  1923.       ENDIF
  1924.       PRINT HEX$(nxt%,4);" ";
  1925.       @prnt(HEX$(nxt%,4)+" ",FALSE)
  1926.       INC sum%
  1927.       a%=kop_buf%+nxt%*2
  1928.     LOOP
  1929.     PRINT
  1930.     PRINT " Das waren ";sum%+1;" Cluster"
  1931.     @prnt(" Das waren "+STR$(sum%+1)+" Cluster",TRUE)
  1932.   ENDIF
  1933. RETURN ! cluster_ausgabe
  1934. PROCEDURE grafik(ab%)
  1935.   LOCAL z%,a%,next%,x%,y%,x$,w$
  1936.   IF CRSLIN>41 THEN
  1937.     z%=40
  1938.     PRINT inv$;" Press a Key! ";norm$;" ";
  1939.     x$=INPUT$(1)
  1940.   ELSE
  1941.     z%=CRSLIN+1
  1942.   ENDIF
  1943.   PRINT AT(1,z%);cltoeop$;
  1944.   LINE 16,z%*16,1015,z%*16
  1945.   x%=(ab% MOD 1000)+16
  1946.   y%=(ab% DIV 1000)*16+z%*16
  1947.   a%=kop_buf%+ab%*2
  1948.   LINE x%,y%,x%,y%+15
  1949.   w$=""
  1950.   DO
  1951.     nxt%=BYTE{a%}+256*BYTE{a%+1}
  1952.     EXIT IF nxt%=&HFFFF OR w$="X" ! Ende der FAT-Schnur
  1953.     x%=(nxt% MOD 1000)+16
  1954.     y%=(nxt% DIV 1000)*16+z%*16
  1955.     LINE x%,y%,x%,y%+15
  1956.     a%=kop_buf%+nxt%*2
  1957.     w$=UPPER$(INKEY$)
  1958.   LOOP
  1959.   LINE 16,(z%+17)*16,1015,(z%+17)*16
  1960.   PRINT AT(1,z%+18);
  1961. RETURN ! grafik
  1962. PROCEDURE melde(in$)
  1963.   PRINT inv$;" *** ";in$;"! *** ";norm$;beep$
  1964.   fehler!=TRUE
  1965. RETURN ! melde
  1966. PROCEDURE show(anfang%,ende%)
  1967.   LOCAL z%,j%,i%,c%,x$
  1968.   z%=(ende%-anfang%) DIV 32
  1969.   FOR j%=0 TO z%
  1970.     FOR i%=0 TO 31
  1971.       PRINT HEX$(BYTE{anfang%+i%+j%*32},2);" ";
  1972.     NEXT i%
  1973.     FOR i%=0 TO 31
  1974.       c%=BYTE{anfang%+i%+j%*32}
  1975.       IF c%>31 AND c%<127 THEN
  1976.         PRINT CHR$(c%);
  1977.       ELSE
  1978.         PRINT ".";
  1979.       ENDIF
  1980.     NEXT i%
  1981.     PRINT
  1982.   NEXT j%
  1983.   PRINT
  1984. RETURN ! show
  1985. '
  1986. PROCEDURE poken
  1987.   LOCAL w$,adr%,wert%
  1988.   PRINT inv$;" Speicherstelle (in HEX bitte!) ";norm$;" ";
  1989.   INPUT "",w$
  1990.   IF w$>"" THEN
  1991.     adr%=VAL("&H"+w$)
  1992.     PRINT inv$;" Wert ";norm$;" lnn, wnn, bnn für LONG,WORD,BYTE, nn jeweils eine HEX-Zahl! ";
  1993.     INPUT "",w$
  1994.     IF w$>"" THEN
  1995.       wert%=VAL("&H"+MID$(w$,2,255))
  1996.       w$=LEFT$(w$,1)
  1997.       SELECT w$
  1998.       CASE "L"
  1999.         IF EVEN(adr%) THEN
  2000.           SLPOKE adr%,wert%
  2001.         ELSE
  2002.           PRINT inv$;" *** Ungerade Speicheradresse ! *** ";norm$;beep$
  2003.         ENDIF
  2004.       CASE "W"
  2005.         IF EVEN(adr%) THEN
  2006.           SDPOKE adr%,wert%
  2007.         ELSE
  2008.           PRINT inv$;" *** Ungerade Speicheradresse ! *** ";norm$;beep$
  2009.         ENDIF
  2010.       CASE "B"
  2011.         SPOKE adr%,wert%
  2012.       ENDSELECT
  2013.     ENDIF
  2014.   ENDIF
  2015. RETURN ! poken
  2016. '
  2017. PROCEDURE del_file(in$)
  2018.   LOCAL e%,dta%,h$,t$
  2019.   IF in$="" THEN
  2020.     PRINT " Welche Datei? ";
  2021.     INPUT "",in$
  2022.   ENDIF
  2023.   fehler!=FALSE
  2024.   @check_drv(in$)
  2025.   IF NOT fehler! THEN
  2026.     dta%=FGETDTA()
  2027.     t$=@set_path$(in$)
  2028.     e%=FSFIRST(in$,-1)
  2029.     IF e%<0 THEN
  2030.       PRINT inv$;" *** Keine Datei gefunden! *** ";norm$;beep$
  2031.     ENDIF
  2032.     DO
  2033.       EXIT IF e%<0
  2034.       h$=CHAR{dta%+30}
  2035.       PRINT " ";h$;" ";inv$;" *** Wirklich Löschen *** ";norm$;" ['J,j'] ";
  2036.       IF UPPER$(INPUT$(1))="J" THEN
  2037.         KILL h$
  2038.       ENDIF
  2039.       PRINT
  2040.       e%=FSNEXT()
  2041.     LOOP
  2042.     @set_path_org
  2043.     fehler!=FALSE
  2044.   ENDIF
  2045.   PRINT
  2046. RETURN ! del_file
  2047. '
  2048. PROCEDURE calc(in$)
  2049.   LOCAL r,h$
  2050.   IF in$="" THEN
  2051.     PRINT " Welche Formel soll berechnet werden? ";
  2052.     FORM INPUT 150 AS calc$
  2053.     in$=calc$
  2054.   ENDIF
  2055.   in$=UPPER$(in$)
  2056.   h$=LEFT$(in$,2)
  2057.   IF in$>"" THEN
  2058.     IF h$="&H" OR h$="&X" OR h$="&O" THEN
  2059.       r=VAL(in$)
  2060.     ELSE
  2061.       r=@evaluate(in$)
  2062.     ENDIF
  2063.     calc$=STR$(r)
  2064.     PRINT in$;" = ";calc$
  2065.     PRINT "(INT ";INT(r);" &H_";HEX$(r,8);" &X_";BIN$(r,32);" &O_";OCT$(r,11);")"
  2066.     @prnt(in$+" = "+calc$,TRUE)
  2067.     @prnt("(INT "+STR$(INT(r))+" &H_"+HEX$(r,8)+" &X_"+BIN$(r,32)+" &O_"+OCT$(r,11)+")",TRUE)
  2068.   ENDIF
  2069. RETURN ! calc
  2070. FUNCTION evaluate(in$)
  2071.   LOCAL i%,c%,w%,s%,falsch!,priority%
  2072.   ' GLOBAL rechns%->rechn%,rechn$, rechnarts%->rechnart$
  2073.   ' Berechnet REAL-Zahlen
  2074.   ' Eingangsstring wird auf unerlaubte Zeichen untersucht
  2075.   rhilf$=in$
  2076.   i%=0
  2077.   FOR c%=1 TO LEN(in$)
  2078.     SELECT MID$(in$,c%,1)
  2079.     CASE ","
  2080.       INC i%
  2081.       MID$(rhilf$,i%,1)="."
  2082.     CASE ".","0" TO "9","+","-","*","/","(",")"
  2083.       INC i%
  2084.       MID$(rhilf$,i%,1)=MID$(in$,c%,1)
  2085.     ENDSELECT
  2086.   NEXT c%
  2087.   in$=LEFT$(rhilf$,i%)
  2088.   ' Ruecksetzung aller Variabeln
  2089.   ARRAYFILL rechn(),0
  2090.   ARRAYFILL priority%(),0
  2091.   FOR i%=0 TO rechns%
  2092.     rechn$(i%)=""
  2093.   NEXT i%
  2094.   priority%=1
  2095.   s%=1
  2096.   falsch!=FALSE
  2097.   rhilf$=""
  2098.   ' 1.Schleife
  2099.   c%=0
  2100.   DO
  2101.     INC c%
  2102.     EXIT IF c%>LEN(in$) OR falsch! OR s%>rechns%
  2103.     w%=ASC(MID$(in$,c%,1))
  2104.     SELECT w%
  2105.     CASE 44,46,48 TO 57 ! ,.0 bis 9
  2106.       rhilf$=rhilf$+CHR$(w%)
  2107.     CASE 40 ! (
  2108.       ADD priority%,2 ! Hoeher als */, INC reicht nicht!
  2109.     CASE 41 ! )
  2110.       SUB priority%,2
  2111.     CASE 42,43,45,47 ! *+-/
  2112.       SELECT w%
  2113.       CASE 42,47 ! */
  2114.         priority%(s%)=priority%+1
  2115.       CASE 43,45 ! +-
  2116.         priority%(s%)=priority%
  2117.       ENDSELECT
  2118.       rechn$(s%)=CHR$(w%)
  2119.       rechn(s%)=VAL(rhilf$)
  2120.       INC s%
  2121.       rhilf$=""
  2122.     DEFAULT
  2123.       falsch!=TRUE
  2124.     ENDSELECT
  2125.   LOOP
  2126.   IF falsch! OR priority%<>1 THEN ! Klammern nicht geschlossen
  2127.     rechn(1)=VAL(in$)+0.123456789
  2128.     rechn_err!=TRUE
  2129.     PRINT beep$;
  2130.   ELSE
  2131.     ' Letzter Wert
  2132.     rechn(s%)=VAL(rhilf$)
  2133.     priority%(s%)=0
  2134.     ' Hoechste Priority finden
  2135.     priority%=0
  2136.     FOR i%=1 TO s%
  2137.       priority%=MAX(priority%,priority%(i%))
  2138.     NEXT i%
  2139.     ' Prioritaeten von oben nach unten durchlaufen
  2140.     INC priority%
  2141.     DO
  2142.       DEC priority%
  2143.       EXIT IF priority%=0
  2144.       ' Array durchforsten
  2145.       i%=0
  2146.       DO
  2147.         INC i%
  2148.         EXIT IF i%>s%
  2149.         ' Arraywert hat entsprechende Prioritaet
  2150.         IF priority%(i%)=priority% THEN
  2151.           rechn(i%+1)=@wert(rechn(i%),rechn(i%+1),rechn$(i%))
  2152.           DELETE rechn(i%)
  2153.           DELETE priority%(i%)
  2154.           FOR c%=i% TO s%
  2155.             ' rechn(c%)=rechn(c%+1)
  2156.             rechn$(c%)=rechn$(c%+1)
  2157.             ' priority%(c%)=priority%(c%+1)
  2158.           NEXT c%
  2159.           DEC s%
  2160.           DEC i%
  2161.         ENDIF
  2162.       LOOP
  2163.     LOOP
  2164.   ENDIF
  2165.   RETURN rechn(1)
  2166. ENDFUNC ! evaluate
  2167. FUNCTION wert(w1,w2,z$)
  2168.   ' Berechnet REAL-Zahlen
  2169.   SELECT z$
  2170.   CASE "+"
  2171.     RETURN w1+w2
  2172.   CASE "-"
  2173.     RETURN w1-w2
  2174.   CASE "*"
  2175.     RETURN w1*w2
  2176.   CASE "/"
  2177.     IF w2<>0 THEN
  2178.       RETURN w1/w2
  2179.     ELSE ! Notloesung
  2180.       PRINT beep$;
  2181.       RETURN 123456789.12
  2182.     ENDIF
  2183.   DEFAULT
  2184.     RETURN 0
  2185.   ENDSELECT
  2186. ENDFUNC ! wert
  2187. '
  2188. PROCEDURE xb
  2189.   LOCAL in$,nr%,er%,p1%,p2%,l1!,l2!
  2190.   PRINT inv$;" --- 'Sie spielen mit dem Feuer!' --- ";norm$;beep$;" Nur bis zu 2 Parameter möglich, z.B.: XBIOS(n,L:p1,p2), mehr nicht! KEINE Überprüfungen!"
  2191.   INPUT " Nummer der XBIOS-Routine ('&H' voranstellen für HEX, RETURN bricht ab, LETZTE CHANCE!) ";in$
  2192.   IF in$>"" THEN
  2193.     nr%=VAL(in$)
  2194.     INPUT " 1.Parameter ('l' voranstellen für long, '&H' für HEX!) ";in$
  2195.     IF in$="" THEN
  2196.       @ergebnis(XBIOS(nr%))
  2197.     ELSE
  2198.       IF LEFT$(in$,1)="l" THEN
  2199.         l1!=TRUE
  2200.         in$=MID$(in$,2,255)
  2201.       ELSE
  2202.         l1!=FALSE
  2203.       ENDIF
  2204.       p1%=VAL(in$)
  2205.       INPUT " 2.Parameter ('l' voranstellen für long, '&H' für HEX!) ";in$
  2206.       IF in$="" THEN
  2207.         IF l1! THEN
  2208.           er%=XBIOS(nr%,L:p1%)
  2209.         ELSE
  2210.           er%=XBIOS(nr%,p1%)
  2211.         ENDIF
  2212.         @ergebnis(er%)
  2213.       ELSE
  2214.         IF LEFT$(in$,1)="l" THEN
  2215.           l2!=TRUE
  2216.           in$=MID$(in$,2,255)
  2217.         ELSE
  2218.           l2!=FALSE
  2219.         ENDIF
  2220.         p2%=VAL(in$)
  2221.         IF l1! THEN
  2222.           IF l2! THEN
  2223.             er%=XBIOS(nr%,L:p1%,L:p2%)
  2224.           ELSE
  2225.             er%=XBIOS(nr%,L:p1%,p2%)
  2226.           ENDIF
  2227.         ELSE
  2228.           IF l2! THEN
  2229.             er%=XBIOS(nr%,p1%,L:p2%)
  2230.           ELSE
  2231.             er%=XBIOS(nr%,p1%,p2%)
  2232.           ENDIF
  2233.         ENDIF
  2234.         @ergebnis(er%)
  2235.       ENDIF
  2236.     ENDIF
  2237.   ENDIF
  2238. RETURN ! xb
  2239. PROCEDURE b
  2240.   LOCAL in$,nr%,er%,p1%,p2%,l1!,l2!
  2241.   PRINT inv$;" --- 'Sie spielen mit dem Feuer!' --- ";norm$;beep$;" Nur bis zu 2 Parameter möglich, z.B.: BIOS(n,L:p1,p2), mehr nicht! KEINE Überprüfungen!"
  2242.   INPUT " Nummer der BIOS-Routine ('&H' voranstellen für HEX, RETURN bricht ab, LETZTE CHANCE!) ";in$
  2243.   IF in$>"" THEN
  2244.     nr%=VAL(in$)
  2245.     INPUT " 1.Parameter ('l' voranstellen für long, '&H' für HEX!) ";in$
  2246.     IF in$="" THEN
  2247.       @ergebnis(BIOS(nr%))
  2248.     ELSE
  2249.       IF LEFT$(in$,1)="l" THEN
  2250.         l1!=TRUE
  2251.         in$=MID$(in$,2,255)
  2252.       ELSE
  2253.         l1!=FALSE
  2254.       ENDIF
  2255.       p1%=VAL(in$)
  2256.       INPUT " 2.Parameter ('l' voranstellen für long, '&H' für HEX!) ";in$
  2257.       IF in$="" THEN
  2258.         IF l1! THEN
  2259.           er%=BIOS(nr%,L:p1%)
  2260.         ELSE
  2261.           er%=BIOS(nr%,p1%)
  2262.         ENDIF
  2263.         @ergebnis(er%)
  2264.       ELSE
  2265.         IF LEFT$(in$,1)="l" THEN
  2266.           l2!=TRUE
  2267.           in$=MID$(in$,2,255)
  2268.         ELSE
  2269.           l2!=FALSE
  2270.         ENDIF
  2271.         p2%=VAL(in$)
  2272.         IF l1! THEN
  2273.           IF l2! THEN
  2274.             er%=BIOS(nr%,L:p1%,L:p2%)
  2275.           ELSE
  2276.             er%=BIOS(nr%,L:p1%,p2%)
  2277.           ENDIF
  2278.         ELSE
  2279.           IF l2! THEN
  2280.             er%=BIOS(nr%,p1%,L:p2%)
  2281.           ELSE
  2282.             er%=BIOS(nr%,p1%,p2%)
  2283.           ENDIF
  2284.         ENDIF
  2285.         @ergebnis(er%)
  2286.       ENDIF
  2287.     ENDIF
  2288.   ENDIF
  2289. RETURN ! b
  2290. PROCEDURE g
  2291.   LOCAL in$,nr%,er%,p1%,p2%,l1!,l2!
  2292.   PRINT inv$;" --- 'Sie spielen mit dem Feuer!' --- ";norm$;beep$;" Nur bis zu 2 Parameter möglich, z.B.: GEMDOS(n,L:p1,p2), mehr nicht! KEINE Überprüfungen!"
  2293.   INPUT " Nummer der GEMDOS-Routine ('&H' voranstellen für HEX, RETURN bricht ab, LETZTE CHANCE!) ";in$
  2294.   IF in$>"" THEN
  2295.     nr%=VAL(in$)
  2296.     INPUT " 1.Parameter ('l' voranstellen für long, '&H' für HEX!) ";in$
  2297.     IF in$="" THEN
  2298.       @ergebnis(GEMDOS(nr%))
  2299.     ELSE
  2300.       IF LEFT$(in$,1)="l" THEN
  2301.         l1!=TRUE
  2302.         in$=MID$(in$,2,255)
  2303.       ELSE
  2304.         l1!=FALSE
  2305.       ENDIF
  2306.       p1%=VAL(in$)
  2307.       INPUT " 2.Parameter ('l' voranstellen für long, '&H' für HEX!) ";in$
  2308.       IF in$="" THEN
  2309.         IF l1! THEN
  2310.           er%=GEMDOS(nr%,L:p1%)
  2311.         ELSE
  2312.           er%=GEMDOS(nr%,p1%)
  2313.         ENDIF
  2314.         @ergebnis(er%)
  2315.       ELSE
  2316.         IF LEFT$(in$,1)="l" THEN
  2317.           l2!=TRUE
  2318.           in$=MID$(in$,2,255)
  2319.         ELSE
  2320.           l2!=FALSE
  2321.         ENDIF
  2322.         p2%=VAL(in$)
  2323.         IF l1! THEN
  2324.           IF l2! THEN
  2325.             er%=GEMDOS(nr%,L:p1%,L:p2%)
  2326.           ELSE
  2327.             er%=GEMDOS(nr%,L:p1%,p2%)
  2328.           ENDIF
  2329.         ELSE
  2330.           IF l2! THEN
  2331.             er%=GEMDOS(nr%,p1%,L:p2%)
  2332.           ELSE
  2333.             er%=GEMDOS(nr%,p1%,p2%)
  2334.           ENDIF
  2335.         ENDIF
  2336.         @ergebnis(er%)
  2337.       ENDIF
  2338.     ENDIF
  2339.   ENDIF
  2340. RETURN ! g
  2341. PROCEDURE ergebnis(in%)
  2342.   PRINT " Ergebnis: d";in%;"=&H";HEX$(in%,8);"=&X";BIN$(in%,32)
  2343.   @prnt(" Ergebnis: d"+STR$(in%)+"=&H"+HEX$(in%,8)+"=&X"+BIN$(in%,32),TRUE)
  2344. RETURN ! ergebnis
  2345. '
  2346. PROCEDURE check_drv(in$)
  2347.   LOCAL p%
  2348.   p%=INSTR(in$,":")
  2349.   IF p%>0 THEN
  2350.     IF p%<>2 THEN
  2351.       PRINT inv$;" *** Falsche Syntax bei Drive-Angabe ! *** ";norm$;beep$
  2352.       fehler!=TRUE
  2353.     ELSE
  2354.       p%=ASC(UPPER$(LEFT$(in$,1)))-65
  2355.       IF p%<0 OR p%>15 THEN
  2356.         PRINT inv$;" *** Kein mögliches Drive unter TOS ! *** ";norm$;beep$
  2357.         fehler!=TRUE
  2358.       ELSE
  2359.         IF NOT drive!(p%) THEN
  2360.           PRINT inv$;" *** Drive nicht angemeldet ! *** ";norm$;beep$
  2361.           fehler!=TRUE
  2362.         ENDIF
  2363.       ENDIF
  2364.     ENDIF
  2365.   ENDIF
  2366. RETURN ! check_drv
  2367. PROCEDURE check_make(in$)
  2368.   LOCAL fh&
  2369.   IF NOT fehler! THEN
  2370.     in$=in$+CHR$(0)
  2371.     fh&=GEMDOS(&H3C,L:VARPTR(in$),0) ! FCreate
  2372.     IF fh&>0 THEN
  2373.       fh&=GEMDOS(&H3E,fh&) ! FClose
  2374.       ~GEMDOS(&H41,L:V:in$) ! FDelete
  2375.     ELSE
  2376.       PRINT inv$;" *** Datei konnte nicht zum Schreiben geöffnet werden! Pfad? *** ";norm$;beep$
  2377.       fehler!=TRUE
  2378.     ENDIF
  2379.   ENDIF
  2380. RETURN ! check_make
  2381. PROCEDURE check_fre(in$,gefordert%)
  2382.   LOCAL p%
  2383.   IF NOT fehler! THEN
  2384.     IF MID$(in$,2,1)=":" THEN
  2385.       p%=ASC(UPPER$(LEFT$(in$,1)))-64
  2386.     ELSE
  2387.       p%=0
  2388.     ENDIF
  2389.     IF DFREE(p%)<gefordert% THEN
  2390.       PRINT inv$;" *** Massenspeicher zu klein! *** ";norm$;beep$
  2391.       fehler!=TRUE
  2392.     ENDIF
  2393.   ENDIF
  2394. RETURN ! check_fre
  2395. '
  2396. PROCEDURE fehler
  2397.   ALERT 3,"** FATALER Fehler **|in SideKick.GFA|Kein Aufruf mehr!|TT arbeitet weiter.",1,"WEITER",dummy%
  2398.   BMOVE scrn_buf%,XBIOS(2),153600
  2399.   IF debug! THEN
  2400.     END ! Schlicht!
  2401.   ELSE ! Accessory: END verboten!
  2402.     DO
  2403.       ~EVNT_TIMER(-1)
  2404.     LOOP
  2405.   ENDIF
  2406. RETURN ! fehler
  2407. '
  2408. PROCEDURE test(in$)
  2409.   PRINT "TEST nur zu Entwicklungszwecken eingebaut!"
  2410. RETURN ! test
  2411. '
  2412.